* makeinfo.el: Don't (require 'texinfmt) - that file doesn't exist
[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
d387c960
JB
61/* The name we're using in resource queries. */
62Lisp_Object Vx_resource_name;
ac63d3d6 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
01f1ba30 199\f
11ae94fe
RS
200/* Error if we are not connected to X. */
201static void
202check_x ()
203{
204 if (x_current_display == 0)
205 error ("X windows are not in use or not initialized");
206}
207
f676886a
JB
208/* Return the Emacs frame-object corresponding to an X window.
209 It could be the frame's main window or an icon window. */
01f1ba30 210
bcb2db92
RS
211/* This function can be called during GC, so use XGCTYPE. */
212
f676886a
JB
213struct frame *
214x_window_to_frame (wdesc)
01f1ba30
JB
215 int wdesc;
216{
f676886a
JB
217 Lisp_Object tail, frame;
218 struct frame *f;
01f1ba30 219
bcb2db92
RS
220 for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
221 tail = XCONS (tail)->cdr)
01f1ba30 222 {
f676886a 223 frame = XCONS (tail)->car;
bcb2db92 224 if (XGCTYPE (frame) != Lisp_Frame)
01f1ba30 225 continue;
f676886a 226 f = XFRAME (frame);
fe24a618 227 if (FRAME_X_WINDOW (f) == wdesc
f676886a
JB
228 || f->display.x->icon_desc == wdesc)
229 return f;
01f1ba30
JB
230 }
231 return 0;
232}
233
01f1ba30 234\f
f676886a 235/* Connect the frame-parameter names for X frames
01f1ba30
JB
236 to the ways of passing the parameter values to the window system.
237
238 The name of a parameter, as a Lisp symbol,
f676886a
JB
239 has an `x-frame-parameter' property which is an integer in Lisp
240 but can be interpreted as an `enum x_frame_parm' in C. */
01f1ba30 241
f676886a 242enum x_frame_parm
01f1ba30
JB
243{
244 X_PARM_FOREGROUND_COLOR,
245 X_PARM_BACKGROUND_COLOR,
246 X_PARM_MOUSE_COLOR,
247 X_PARM_CURSOR_COLOR,
248 X_PARM_BORDER_COLOR,
249 X_PARM_ICON_TYPE,
250 X_PARM_FONT,
251 X_PARM_BORDER_WIDTH,
252 X_PARM_INTERNAL_BORDER_WIDTH,
253 X_PARM_NAME,
254 X_PARM_AUTORAISE,
255 X_PARM_AUTOLOWER,
a3c87d4e 256 X_PARM_VERT_SCROLL_BAR,
d043f1a4
RS
257 X_PARM_VISIBILITY,
258 X_PARM_MENU_BAR_LINES
01f1ba30
JB
259};
260
261
f676886a 262struct x_frame_parm_table
01f1ba30
JB
263{
264 char *name;
f676886a 265 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
01f1ba30
JB
266};
267
268void x_set_foreground_color ();
269void x_set_background_color ();
270void x_set_mouse_color ();
271void x_set_cursor_color ();
272void x_set_border_color ();
dbc4e1c1 273void x_set_cursor_type ();
01f1ba30
JB
274void x_set_icon_type ();
275void x_set_font ();
276void x_set_border_width ();
277void x_set_internal_border_width ();
f945b920 278void x_explicitly_set_name ();
01f1ba30
JB
279void x_set_autoraise ();
280void x_set_autolower ();
a3c87d4e 281void x_set_vertical_scroll_bars ();
d043f1a4
RS
282void x_set_visibility ();
283void x_set_menu_bar_lines ();
01f1ba30 284
f676886a 285static struct x_frame_parm_table x_frame_parms[] =
01f1ba30
JB
286{
287 "foreground-color", x_set_foreground_color,
288 "background-color", x_set_background_color,
289 "mouse-color", x_set_mouse_color,
290 "cursor-color", x_set_cursor_color,
291 "border-color", x_set_border_color,
dbc4e1c1 292 "cursor-type", x_set_cursor_type,
01f1ba30
JB
293 "icon-type", x_set_icon_type,
294 "font", x_set_font,
295 "border-width", x_set_border_width,
296 "internal-border-width", x_set_internal_border_width,
f945b920 297 "name", x_explicitly_set_name,
baaed68e
JB
298 "auto-raise", x_set_autoraise,
299 "auto-lower", x_set_autolower,
a3c87d4e 300 "vertical-scroll-bars", x_set_vertical_scroll_bars,
d043f1a4
RS
301 "visibility", x_set_visibility,
302 "menu-bar-lines", x_set_menu_bar_lines,
01f1ba30
JB
303};
304
f676886a 305/* Attach the `x-frame-parameter' properties to
01f1ba30
JB
306 the Lisp symbol names of parameters relevant to X. */
307
308init_x_parm_symbols ()
309{
310 int i;
311
d043f1a4 312 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
f676886a 313 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
01f1ba30
JB
314 make_number (i));
315}
316\f
f9942c9e
JB
317/* Change the parameters of FRAME as specified by ALIST.
318 If a parameter is not specially recognized, do nothing;
319 otherwise call the `x_set_...' function for that parameter. */
d043f1a4 320
f9942c9e
JB
321void
322x_set_frame_parameters (f, alist)
323 FRAME_PTR f;
324 Lisp_Object alist;
325{
326 Lisp_Object tail;
327
328 /* If both of these parameters are present, it's more efficient to
329 set them both at once. So we wait until we've looked at the
330 entire list before we set them. */
331 Lisp_Object width, height;
332
333 /* Same here. */
334 Lisp_Object left, top;
f9942c9e 335
f5e70acd
RS
336 /* Record in these vectors all the parms specified. */
337 Lisp_Object *parms;
338 Lisp_Object *values;
339 int i;
340
341 i = 0;
342 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
343 i++;
344
345 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
346 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
f9942c9e 347
f5e70acd
RS
348 /* Extract parm names and values into those vectors. */
349
350 i = 0;
f9942c9e
JB
351 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
352 {
353 Lisp_Object elt, prop, val;
354
355 elt = Fcar (tail);
f5e70acd
RS
356 parms[i] = Fcar (elt);
357 values[i] = Fcdr (elt);
358 i++;
359 }
360
d387c960 361 width = height = top = left = Qunbound;
f9942c9e 362
f5e70acd
RS
363 /* Now process them in reverse of specified order. */
364 for (i--; i >= 0; i--)
365 {
366 Lisp_Object prop, val;
367
368 prop = parms[i];
369 val = values[i];
370
371 if (EQ (prop, Qwidth))
f9942c9e 372 width = val;
f5e70acd 373 else if (EQ (prop, Qheight))
f9942c9e 374 height = val;
f5e70acd 375 else if (EQ (prop, Qtop))
f9942c9e 376 top = val;
f5e70acd 377 else if (EQ (prop, Qleft))
f9942c9e
JB
378 left = val;
379 else
380 {
ea96210c
JB
381 register Lisp_Object param_index = Fget (prop, Qx_frame_parameter);
382 register Lisp_Object old_value = get_frame_param (f, prop);
383
f9942c9e 384 store_frame_param (f, prop, val);
ea96210c
JB
385 if (XTYPE (param_index) == Lisp_Int
386 && XINT (param_index) >= 0
387 && (XINT (param_index)
388 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
389 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
f9942c9e
JB
390 }
391 }
392
d387c960
JB
393 /* Don't set these parameters these unless they've been explicitly
394 specified. The window might be mapped or resized while we're in
395 this function, and we don't want to override that unless the lisp
396 code has asked for it.
397
398 Don't set these parameters unless they actually differ from the
399 window's current parameters; the window may not actually exist
400 yet. */
f9942c9e
JB
401 {
402 Lisp_Object frame;
403
404 XSET (frame, Lisp_Frame, f);
d387c960
JB
405 if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f))
406 || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f)))
f9942c9e 407 Fset_frame_size (frame, width, height);
d387c960
JB
408 if ((NUMBERP (left) && XINT (left) != f->display.x->left_pos)
409 || (NUMBERP (top) && XINT (top) != f->display.x->top_pos))
f9942c9e
JB
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
d387c960
JB
1104
1105/* Make sure that Vx_resource_name is set to a reasonable value. */
1106static void
1107validate_x_resource_name ()
1108{
1109 if (! STRINGP (Vx_resource_name))
1110 Vx_resource_name = make_string ("emacs");
1111}
1112
1113
01f1ba30
JB
1114extern char *x_get_string_resource ();
1115extern XrmDatabase x_load_resources ();
1116
cf177271
JB
1117DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1118 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
d387c960
JB
1119This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1120class, where INSTANCE is the name under which Emacs was invoked, or\n\
1121the name specified by the `-name' or `-rn' command-line arguments.\n\
01f1ba30 1122\n\
8fabe6f4
RS
1123The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1124class, respectively. You must specify both of them or neither.\n\
d387c960 1125If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
cf177271
JB
1126and the class is `Emacs.CLASS.SUBCLASS'.")
1127 (attribute, class, component, subclass)
1128 Lisp_Object attribute, class, component, subclass;
01f1ba30
JB
1129{
1130 register char *value;
1131 char *name_key;
1132 char *class_key;
1133
11ae94fe
RS
1134 check_x ();
1135
01f1ba30 1136 CHECK_STRING (attribute, 0);
cf177271
JB
1137 CHECK_STRING (class, 0);
1138
8fabe6f4
RS
1139 if (!NILP (component))
1140 CHECK_STRING (component, 1);
1141 if (!NILP (subclass))
1142 CHECK_STRING (subclass, 2);
1143 if (NILP (component) != NILP (subclass))
1144 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1145
d387c960
JB
1146 validate_x_resource_name ();
1147
8fabe6f4 1148 if (NILP (component))
01f1ba30 1149 {
cf177271
JB
1150 /* Allocate space for the components, the dots which separate them,
1151 and the final '\0'. */
d387c960 1152 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
cf177271
JB
1153 + XSTRING (attribute)->size
1154 + 2);
1155 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1156 + XSTRING (class)->size
1157 + 2);
60fb3ee1 1158
01f1ba30 1159 sprintf (name_key, "%s.%s",
d387c960 1160 XSTRING (Vx_resource_name)->data,
01f1ba30 1161 XSTRING (attribute)->data);
cf177271
JB
1162 sprintf (class_key, "%s.%s",
1163 EMACS_CLASS,
1164 XSTRING (class)->data);
01f1ba30
JB
1165 }
1166 else
1167 {
d387c960 1168 name_key = (char *) alloca (XSTRING (Vx_resource_name)->size
cf177271
JB
1169 + XSTRING (component)->size
1170 + XSTRING (attribute)->size
1171 + 3);
60fb3ee1 1172
cf177271
JB
1173 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1174 + XSTRING (class)->size
1175 + XSTRING (subclass)->size
1176 + 3);
01f1ba30
JB
1177
1178 sprintf (name_key, "%s.%s.%s",
d387c960 1179 XSTRING (Vx_resource_name)->data,
8fabe6f4 1180 XSTRING (component)->data,
01f1ba30 1181 XSTRING (attribute)->data);
ac63d3d6 1182 sprintf (class_key, "%s.%s.%s",
cf177271
JB
1183 EMACS_CLASS,
1184 XSTRING (class)->data,
1185 XSTRING (subclass)->data);
01f1ba30
JB
1186 }
1187
1188 value = x_get_string_resource (xrdb, name_key, class_key);
1189
1190 if (value != (char *) 0)
1191 return build_string (value);
1192 else
1193 return Qnil;
1194}
1195
3402e1a4
RS
1196/* Used when C code wants a resource value. */
1197
1198char *
1199x_get_resource_string (attribute, class)
1200 char *attribute, *class;
1201{
1202 register char *value;
1203 char *name_key;
1204 char *class_key;
1205
1206 /* Allocate space for the components, the dots which separate them,
1207 and the final '\0'. */
1208 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1209 + strlen (attribute) + 2);
1210 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1211 + strlen (class) + 2);
1212
1213 sprintf (name_key, "%s.%s",
1214 XSTRING (Vinvocation_name)->data,
1215 attribute);
1216 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
1217
1218 return x_get_string_resource (xrdb, name_key, class_key);
1219}
1220
01f1ba30
JB
1221#else /* X10 */
1222
60fb3ee1 1223DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
f9942c9e 1224 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
01f1ba30
JB
1225Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1226The defaults are specified in the file `~/.Xdefaults'.")
60fb3ee1
JB
1227 (arg)
1228 Lisp_Object arg;
01f1ba30
JB
1229{
1230 register unsigned char *value;
1231
1232 CHECK_STRING (arg, 1);
1233
1234 value = (unsigned char *) XGetDefault (XDISPLAY
59653951 1235 XSTRING (Vinvocation_name)->data,
01f1ba30
JB
1236 XSTRING (arg)->data);
1237 if (value == 0)
1238 /* Try reversing last two args, in case this is the buggy version of X. */
1239 value = (unsigned char *) XGetDefault (XDISPLAY
1240 XSTRING (arg)->data,
59653951 1241 XSTRING (Vinvocation_name)->data);
01f1ba30
JB
1242 if (value != 0)
1243 return build_string (value);
1244 else
1245 return (Qnil);
1246}
1247
cf177271
JB
1248#define Fx_get_resource(attribute, class, component, subclass) \
1249 Fx_get_default(attribute)
01f1ba30
JB
1250
1251#endif /* X10 */
1252
60fb3ee1
JB
1253/* Types we might convert a resource string into. */
1254enum resource_types
1255 {
f945b920 1256 number, boolean, string, symbol,
60fb3ee1
JB
1257 };
1258
01f1ba30 1259/* Return the value of parameter PARAM.
60fb3ee1 1260
f676886a 1261 First search ALIST, then Vdefault_frame_alist, then the X defaults
cf177271 1262 database, using ATTRIBUTE as the attribute name and CLASS as its class.
60fb3ee1
JB
1263
1264 Convert the resource to the type specified by desired_type.
1265
f9942c9e
JB
1266 If no default is specified, return Qunbound. If you call
1267 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1268 and don't let it get stored in any lisp-visible variables! */
01f1ba30
JB
1269
1270static Lisp_Object
cf177271 1271x_get_arg (alist, param, attribute, class, type)
3c254570 1272 Lisp_Object alist, param;
60fb3ee1 1273 char *attribute;
cf177271 1274 char *class;
60fb3ee1 1275 enum resource_types type;
01f1ba30
JB
1276{
1277 register Lisp_Object tem;
1278
1279 tem = Fassq (param, alist);
1280 if (EQ (tem, Qnil))
f676886a 1281 tem = Fassq (param, Vdefault_frame_alist);
f9942c9e 1282 if (EQ (tem, Qnil))
01f1ba30 1283 {
60fb3ee1 1284
f9942c9e 1285 if (attribute)
60fb3ee1 1286 {
cf177271
JB
1287 tem = Fx_get_resource (build_string (attribute),
1288 build_string (class),
1289 Qnil, Qnil);
f9942c9e
JB
1290
1291 if (NILP (tem))
1292 return Qunbound;
1293
1294 switch (type)
1295 {
1296 case number:
1297 return make_number (atoi (XSTRING (tem)->data));
1298
1299 case boolean:
1300 tem = Fdowncase (tem);
1301 if (!strcmp (XSTRING (tem)->data, "on")
1302 || !strcmp (XSTRING (tem)->data, "true"))
1303 return Qt;
1304 else
1305 return Qnil;
1306
1307 case string:
1308 return tem;
1309
f945b920 1310 case symbol:
49795535
JB
1311 /* As a special case, we map the values `true' and `on'
1312 to Qt, and `false' and `off' to Qnil. */
1313 {
1314 Lisp_Object lower = Fdowncase (tem);
1315 if (!strcmp (XSTRING (tem)->data, "on")
1316 || !strcmp (XSTRING (tem)->data, "true"))
1317 return Qt;
8bc59570 1318 else if (!strcmp (XSTRING (tem)->data, "off")
49795535
JB
1319 || !strcmp (XSTRING (tem)->data, "false"))
1320 return Qnil;
1321 else
89032215 1322 return Fintern (tem, Qnil);
49795535 1323 }
f945b920 1324
f9942c9e
JB
1325 default:
1326 abort ();
1327 }
60fb3ee1 1328 }
f9942c9e
JB
1329 else
1330 return Qunbound;
01f1ba30
JB
1331 }
1332 return Fcdr (tem);
1333}
1334
f676886a 1335/* Record in frame F the specified or default value according to ALIST
01f1ba30
JB
1336 of the parameter named PARAM (a Lisp symbol).
1337 If no value is specified for PARAM, look for an X default for XPROP
f676886a 1338 on the frame named NAME.
01f1ba30
JB
1339 If that is not found either, use the value DEFLT. */
1340
1341static Lisp_Object
cf177271 1342x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
f676886a 1343 struct frame *f;
01f1ba30 1344 Lisp_Object alist;
f9942c9e 1345 Lisp_Object prop;
01f1ba30
JB
1346 Lisp_Object deflt;
1347 char *xprop;
cf177271 1348 char *xclass;
60fb3ee1 1349 enum resource_types type;
01f1ba30 1350{
01f1ba30
JB
1351 Lisp_Object tem;
1352
cf177271 1353 tem = x_get_arg (alist, prop, xprop, xclass, type);
f9942c9e 1354 if (EQ (tem, Qunbound))
01f1ba30 1355 tem = deflt;
f9942c9e 1356 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
01f1ba30
JB
1357 return tem;
1358}
1359\f
8af1d7ca 1360DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
01f1ba30
JB
1361 "Parse an X-style geometry string STRING.\n\
1362Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1363 (string)
a6605e5c 1364 Lisp_Object string;
01f1ba30
JB
1365{
1366 int geometry, x, y;
1367 unsigned int width, height;
1368 Lisp_Object values[4];
1369
1370 CHECK_STRING (string, 0);
1371
1372 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1373 &x, &y, &width, &height);
1374
1375 switch (geometry & 0xf) /* Mask out {X,Y}Negative */
1376 {
1377 case (XValue | YValue):
1378 /* What's one pixel among friends?
1379 Perhaps fix this some day by returning symbol `extreme-top'... */
1380 if (x == 0 && (geometry & XNegative))
1381 x = -1;
1382 if (y == 0 && (geometry & YNegative))
1383 y = -1;
f9942c9e
JB
1384 values[0] = Fcons (Qleft, make_number (x));
1385 values[1] = Fcons (Qtop, make_number (y));
01f1ba30
JB
1386 return Flist (2, values);
1387 break;
1388
1389 case (WidthValue | HeightValue):
f9942c9e
JB
1390 values[0] = Fcons (Qwidth, make_number (width));
1391 values[1] = Fcons (Qheight, make_number (height));
01f1ba30
JB
1392 return Flist (2, values);
1393 break;
1394
1395 case (XValue | YValue | WidthValue | HeightValue):
1396 if (x == 0 && (geometry & XNegative))
1397 x = -1;
1398 if (y == 0 && (geometry & YNegative))
1399 y = -1;
f9942c9e
JB
1400 values[0] = Fcons (Qwidth, make_number (width));
1401 values[1] = Fcons (Qheight, make_number (height));
1402 values[2] = Fcons (Qleft, make_number (x));
1403 values[3] = Fcons (Qtop, make_number (y));
01f1ba30
JB
1404 return Flist (4, values);
1405 break;
1406
1407 case 0:
1408 return Qnil;
1409
1410 default:
1411 error ("Must specify x and y value, and/or width and height");
1412 }
1413}
1414
1415#ifdef HAVE_X11
1416/* Calculate the desired size and position of this window,
1417 or set rubber-band prompting if none. */
1418
1419#define DEFAULT_ROWS 40
1420#define DEFAULT_COLS 80
1421
f9942c9e 1422static int
f676886a
JB
1423x_figure_window_size (f, parms)
1424 struct frame *f;
01f1ba30
JB
1425 Lisp_Object parms;
1426{
1427 register Lisp_Object tem0, tem1;
1428 int height, width, left, top;
1429 register int geometry;
1430 long window_prompting = 0;
1431
1432 /* Default values if we fall through.
1433 Actually, if that happens we should get
1434 window manager prompting. */
f676886a
JB
1435 f->width = DEFAULT_COLS;
1436 f->height = DEFAULT_ROWS;
bd0b85c3
RS
1437 /* Window managers expect that if program-specified
1438 positions are not (0,0), they're intentional, not defaults. */
1439 f->display.x->top_pos = 0;
1440 f->display.x->left_pos = 0;
01f1ba30 1441
cf177271
JB
1442 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
1443 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
f9942c9e 1444 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
01f1ba30
JB
1445 {
1446 CHECK_NUMBER (tem0, 0);
1447 CHECK_NUMBER (tem1, 0);
f676886a
JB
1448 f->height = XINT (tem0);
1449 f->width = XINT (tem1);
01f1ba30
JB
1450 window_prompting |= USSize;
1451 }
f9942c9e 1452 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
01f1ba30
JB
1453 error ("Must specify *both* height and width");
1454
739f2f53
RS
1455 f->display.x->vertical_scroll_bar_extra
1456 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1457 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f)
1458 : 0);
179956b9
JB
1459 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
1460 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
01f1ba30 1461
cf177271
JB
1462 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
1463 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
f9942c9e 1464 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
01f1ba30
JB
1465 {
1466 CHECK_NUMBER (tem0, 0);
1467 CHECK_NUMBER (tem1, 0);
f676886a
JB
1468 f->display.x->top_pos = XINT (tem0);
1469 f->display.x->left_pos = XINT (tem1);
1470 x_calc_absolute_position (f);
01f1ba30
JB
1471 window_prompting |= USPosition;
1472 }
f9942c9e 1473 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
01f1ba30
JB
1474 error ("Must specify *both* top and left corners");
1475
739f2f53
RS
1476#if 0 /* PPosition and PSize mean "specified explicitly,
1477 by the program rather than by the user". So it is wrong to
1478 set them if nothing was specified. */
01f1ba30
JB
1479 switch (window_prompting)
1480 {
1481 case USSize | USPosition:
1482 return window_prompting;
1483 break;
1484
1485 case USSize: /* Got the size, need the position. */
1486 window_prompting |= PPosition;
1487 return window_prompting;
1488 break;
1489
1490 case USPosition: /* Got the position, need the size. */
1491 window_prompting |= PSize;
1492 return window_prompting;
1493 break;
1494
1495 case 0: /* Got nothing, take both from geometry. */
1496 window_prompting |= PPosition | PSize;
1497 return window_prompting;
1498 break;
1499
1500 default:
1501 /* Somehow a bit got set in window_prompting that we didn't
1502 put there. */
1503 abort ();
1504 }
739f2f53
RS
1505#endif
1506 return window_prompting;
01f1ba30
JB
1507}
1508
1509static void
f676886a
JB
1510x_window (f)
1511 struct frame *f;
01f1ba30
JB
1512{
1513 XSetWindowAttributes attributes;
1514 unsigned long attribute_mask;
1515 XClassHint class_hints;
1516
f676886a
JB
1517 attributes.background_pixel = f->display.x->background_pixel;
1518 attributes.border_pixel = f->display.x->border_pixel;
01f1ba30
JB
1519 attributes.bit_gravity = StaticGravity;
1520 attributes.backing_store = NotUseful;
1521 attributes.save_under = True;
1522 attributes.event_mask = STANDARD_EVENT_SET;
1523 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
1524#if 0
1525 | CWBackingStore | CWSaveUnder
1526#endif
1527 | CWEventMask);
1528
1529 BLOCK_INPUT;
fe24a618 1530 FRAME_X_WINDOW (f)
01f1ba30 1531 = XCreateWindow (x_current_display, ROOT_WINDOW,
f676886a
JB
1532 f->display.x->left_pos,
1533 f->display.x->top_pos,
1534 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
1535 f->display.x->border_width,
01f1ba30
JB
1536 CopyFromParent, /* depth */
1537 InputOutput, /* class */
1538 screen_visual, /* set in Fx_open_connection */
1539 attribute_mask, &attributes);
1540
d387c960
JB
1541 validate_x_resource_name ();
1542 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
01f1ba30 1543 class_hints.res_class = EMACS_CLASS;
fe24a618 1544 XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
01f1ba30 1545
179956b9
JB
1546 /* This indicates that we use the "Passive Input" input model.
1547 Unless we do this, we don't get the Focus{In,Out} events that we
1548 need to draw the cursor correctly. Accursed bureaucrats.
1549 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1550
1551 f->display.x->wm_hints.input = True;
1552 f->display.x->wm_hints.flags |= InputHint;
1553 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
1554
e373f201
JB
1555 /* x_set_name normally ignores requests to set the name if the
1556 requested name is the same as the current name. This is the one
1557 place where that assumption isn't correct; f->name is set, but
1558 the X server hasn't been told. */
1559 {
1560 Lisp_Object name = f->name;
cf177271 1561 int explicit = f->explicit_name;
e373f201
JB
1562
1563 f->name = Qnil;
cf177271
JB
1564 f->explicit_name = 0;
1565 x_set_name (f, name, explicit);
e373f201
JB
1566 }
1567
fe24a618 1568 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
f676886a 1569 f->display.x->text_cursor);
01f1ba30
JB
1570 UNBLOCK_INPUT;
1571
fe24a618 1572 if (FRAME_X_WINDOW (f) == 0)
01f1ba30
JB
1573 error ("Unable to create window.");
1574}
1575
1576/* Handle the icon stuff for this window. Perhaps later we might
1577 want an x_set_icon_position which can be called interactively as
1578 well. */
1579
1580static void
f676886a
JB
1581x_icon (f, parms)
1582 struct frame *f;
01f1ba30
JB
1583 Lisp_Object parms;
1584{
f9942c9e 1585 Lisp_Object icon_x, icon_y;
01f1ba30
JB
1586
1587 /* Set the position of the icon. Note that twm groups all
1588 icons in an icon window. */
cf177271
JB
1589 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
1590 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
f9942c9e 1591 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
01f1ba30 1592 {
f9942c9e
JB
1593 CHECK_NUMBER (icon_x, 0);
1594 CHECK_NUMBER (icon_y, 0);
01f1ba30 1595 }
f9942c9e 1596 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
01f1ba30 1597 error ("Both left and top icon corners of icon must be specified");
01f1ba30 1598
f9942c9e
JB
1599 BLOCK_INPUT;
1600
fe24a618
JB
1601 if (! EQ (icon_x, Qunbound))
1602 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
f9942c9e 1603
01f1ba30 1604 /* Start up iconic or window? */
49795535
JB
1605 x_wm_set_window_state
1606 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
1607 ? IconicState
1608 : NormalState));
01f1ba30 1609
01f1ba30
JB
1610 UNBLOCK_INPUT;
1611}
1612
1613/* Make the GC's needed for this window, setting the
1614 background, border and mouse colors; also create the
1615 mouse cursor and the gray border tile. */
1616
f945b920
JB
1617static char cursor_bits[] =
1618 {
1619 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1620 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1621 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1622 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1623 };
1624
01f1ba30 1625static void
f676886a
JB
1626x_make_gc (f)
1627 struct frame *f;
01f1ba30
JB
1628{
1629 XGCValues gc_values;
1630 GC temp_gc;
1631 XImage tileimage;
01f1ba30 1632
6afb1d07
JB
1633 BLOCK_INPUT;
1634
f676886a 1635 /* Create the GC's of this frame.
01f1ba30
JB
1636 Note that many default values are used. */
1637
1638 /* Normal video */
f676886a
JB
1639 gc_values.font = f->display.x->font->fid;
1640 gc_values.foreground = f->display.x->foreground_pixel;
1641 gc_values.background = f->display.x->background_pixel;
01f1ba30 1642 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
f676886a 1643 f->display.x->normal_gc = XCreateGC (x_current_display,
fe24a618 1644 FRAME_X_WINDOW (f),
01f1ba30
JB
1645 GCLineWidth | GCFont
1646 | GCForeground | GCBackground,
1647 &gc_values);
1648
1649 /* Reverse video style. */
f676886a
JB
1650 gc_values.foreground = f->display.x->background_pixel;
1651 gc_values.background = f->display.x->foreground_pixel;
1652 f->display.x->reverse_gc = XCreateGC (x_current_display,
fe24a618 1653 FRAME_X_WINDOW (f),
01f1ba30
JB
1654 GCFont | GCForeground | GCBackground
1655 | GCLineWidth,
1656 &gc_values);
1657
1658 /* Cursor has cursor-color background, background-color foreground. */
f676886a
JB
1659 gc_values.foreground = f->display.x->background_pixel;
1660 gc_values.background = f->display.x->cursor_pixel;
01f1ba30
JB
1661 gc_values.fill_style = FillOpaqueStippled;
1662 gc_values.stipple
1663 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1664 cursor_bits, 16, 16);
f676886a 1665 f->display.x->cursor_gc
fe24a618 1666 = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
1667 (GCFont | GCForeground | GCBackground
1668 | GCFillStyle | GCStipple | GCLineWidth),
1669 &gc_values);
1670
1671 /* Create the gray border tile used when the pointer is not in
f676886a
JB
1672 the frame. Since this depends on the frame's pixel values,
1673 this must be done on a per-frame basis. */
d043f1a4
RS
1674 f->display.x->border_tile
1675 = (XCreatePixmapFromBitmapData
1676 (x_current_display, ROOT_WINDOW,
1677 gray_bits, gray_width, gray_height,
1678 f->display.x->foreground_pixel,
1679 f->display.x->background_pixel,
1680 DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
6afb1d07
JB
1681
1682 UNBLOCK_INPUT;
01f1ba30
JB
1683}
1684#endif /* HAVE_X11 */
1685
f676886a 1686DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
01f1ba30 1687 1, 1, 0,
f676886a
JB
1688 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1689Return an Emacs frame object representing the X window.\n\
1690ALIST is an alist of frame parameters.\n\
1691If the parameters specify that the frame should not have a minibuffer,\n\
e22d6b02 1692and do not specify a specific minibuffer window to use,\n\
f676886a
JB
1693then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1694be shared by the new frame.")
01f1ba30
JB
1695 (parms)
1696 Lisp_Object parms;
1697{
1698#ifdef HAVE_X11
f676886a
JB
1699 struct frame *f;
1700 Lisp_Object frame, tem;
01f1ba30
JB
1701 Lisp_Object name;
1702 int minibuffer_only = 0;
1703 long window_prompting = 0;
1704 int width, height;
1705
11ae94fe 1706 check_x ();
01f1ba30 1707
cf177271
JB
1708 name = x_get_arg (parms, Qname, "title", "Title", string);
1709 if (XTYPE (name) != Lisp_String
1710 && ! EQ (name, Qunbound)
1711 && ! NILP (name))
f676886a 1712 error ("x-create-frame: name parameter must be a string");
01f1ba30 1713
cf177271 1714 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
f9942c9e 1715 if (EQ (tem, Qnone) || NILP (tem))
f676886a 1716 f = make_frame_without_minibuffer (Qnil);
f9942c9e 1717 else if (EQ (tem, Qonly))
01f1ba30 1718 {
f676886a 1719 f = make_minibuffer_frame ();
01f1ba30
JB
1720 minibuffer_only = 1;
1721 }
f9942c9e 1722 else if (XTYPE (tem) == Lisp_Window)
f676886a 1723 f = make_frame_without_minibuffer (tem);
f9942c9e
JB
1724 else
1725 f = make_frame (1);
01f1ba30 1726
a3c87d4e
JB
1727 /* Note that X Windows does support scroll bars. */
1728 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
179956b9 1729
cf177271
JB
1730 /* Set the name; the functions to which we pass f expect the name to
1731 be set. */
1732 if (EQ (name, Qunbound) || NILP (name))
1733 {
1734 f->name = build_string (x_id_name);
1735 f->explicit_name = 0;
1736 }
1737 else
1738 {
1739 f->name = name;
1740 f->explicit_name = 1;
1741 }
01f1ba30 1742
f676886a
JB
1743 XSET (frame, Lisp_Frame, f);
1744 f->output_method = output_x_window;
1745 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1746 bzero (f->display.x, sizeof (struct x_display));
01f1ba30 1747
f676886a
JB
1748 /* Note that the frame has no physical cursor right now. */
1749 f->phys_cursor_x = -1;
265a9e55 1750
01f1ba30
JB
1751 /* Extract the window parameters from the supplied values
1752 that are needed to determine window geometry. */
d387c960
JB
1753 {
1754 Lisp_Object font;
1755
1756 /* Try out a font which we know has bold and italic variations. */
1757 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
1758 if (NILP (font))
1759 font = build_string ("-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
1760
1761 x_default_parameter (f, parms, Qfont, font,
1762 "font", "Font", string);
1763 }
cf177271
JB
1764 x_default_parameter (f, parms, Qborder_width, make_number (2),
1765 "borderwidth", "BorderWidth", number);
ddf768c3
JB
1766 /* This defaults to 2 in order to match xterm. We recognize either
1767 internalBorderWidth or internalBorder (which is what xterm calls
1768 it). */
1769 if (NILP (Fassq (Qinternal_border_width, parms)))
1770 {
1771 Lisp_Object value;
1772
1773 value = x_get_arg (parms, Qinternal_border_width,
1774 "internalBorder", "BorderWidth", number);
1775 if (! EQ (value, Qunbound))
1776 parms = Fcons (Fcons (Qinternal_border_width, value),
1777 parms);
1778 }
cf177271
JB
1779 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1780 "internalBorderWidth", "BorderWidth", number);
a3c87d4e
JB
1781 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
1782 "verticalScrollBars", "ScrollBars", boolean);
01f1ba30
JB
1783
1784 /* Also do the stuff which must be set before the window exists. */
cf177271
JB
1785 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
1786 "foreground", "Foreground", string);
1787 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
1788 "background", "Background", string);
1789 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
1790 "pointerColor", "Foreground", string);
1791 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
1792 "cursorColor", "Foreground", string);
1793 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
1794 "borderColor", "BorderColor", string);
01f1ba30 1795
f676886a
JB
1796 f->display.x->parent_desc = ROOT_WINDOW;
1797 window_prompting = x_figure_window_size (f, parms);
01f1ba30 1798
f676886a
JB
1799 x_window (f);
1800 x_icon (f, parms);
1801 x_make_gc (f);
ea96210c 1802 init_frame_faces (f);
01f1ba30 1803
f9942c9e
JB
1804 /* We need to do this after creating the X window, so that the
1805 icon-creation functions can say whose icon they're describing. */
cf177271 1806 x_default_parameter (f, parms, Qicon_type, Qnil,
6998a3b4 1807 "bitmapIcon", "BitmapIcon", symbol);
f9942c9e 1808
cf177271
JB
1809 x_default_parameter (f, parms, Qauto_raise, Qnil,
1810 "autoRaise", "AutoRaiseLower", boolean);
1811 x_default_parameter (f, parms, Qauto_lower, Qnil,
1812 "autoLower", "AutoRaiseLower", boolean);
dbc4e1c1
JB
1813 x_default_parameter (f, parms, Qcursor_type, Qbox,
1814 "cursorType", "CursorType", symbol);
f9942c9e 1815
f676886a 1816 /* Dimensions, especially f->height, must be done via change_frame_size.
01f1ba30 1817 Change will not be effected unless different from the current
f676886a
JB
1818 f->height. */
1819 width = f->width;
1820 height = f->height;
1821 f->height = f->width = 0;
f9942c9e 1822 change_frame_size (f, height, width, 1, 0);
d043f1a4
RS
1823
1824 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0),
1825 "menuBarLines", "MenuBarLines", number);
1826
01f1ba30 1827 BLOCK_INPUT;
f676886a 1828 x_wm_set_size_hint (f, window_prompting);
01f1ba30
JB
1829 UNBLOCK_INPUT;
1830
cf177271 1831 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
f676886a 1832 f->no_split = minibuffer_only || EQ (tem, Qt);
01f1ba30 1833
d043f1a4
RS
1834 /* Make the window appear on the frame and enable display,
1835 unless the caller says not to. */
49795535
JB
1836 {
1837 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
1838
1839 if (EQ (visibility, Qunbound))
1840 visibility = Qt;
1841
1842 if (EQ (visibility, Qicon))
1843 x_iconify_frame (f);
1844 else if (! NILP (visibility))
1845 x_make_frame_visible (f);
1846 else
1847 /* Must have been Qnil. */
1848 ;
1849 }
01f1ba30 1850
f676886a 1851 return frame;
01f1ba30 1852#else /* X10 */
f676886a
JB
1853 struct frame *f;
1854 Lisp_Object frame, tem;
01f1ba30
JB
1855 Lisp_Object name;
1856 int pixelwidth, pixelheight;
1857 Cursor cursor;
1858 int height, width;
1859 Window parent;
1860 Pixmap temp;
1861 int minibuffer_only = 0;
1862 Lisp_Object vscroll, hscroll;
1863
1864 if (x_current_display == 0)
1865 error ("X windows are not in use or not initialized");
1866
f9942c9e 1867 name = Fassq (Qname, parms);
01f1ba30 1868
cf177271 1869 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
f9942c9e 1870 if (EQ (tem, Qnone))
f676886a 1871 f = make_frame_without_minibuffer (Qnil);
f9942c9e 1872 else if (EQ (tem, Qonly))
01f1ba30 1873 {
f676886a 1874 f = make_minibuffer_frame ();
01f1ba30
JB
1875 minibuffer_only = 1;
1876 }
f9942c9e 1877 else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
f676886a 1878 f = make_frame (1);
f9942c9e
JB
1879 else
1880 f = make_frame_without_minibuffer (tem);
01f1ba30
JB
1881
1882 parent = ROOT_WINDOW;
1883
f676886a
JB
1884 XSET (frame, Lisp_Frame, f);
1885 f->output_method = output_x_window;
1886 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1887 bzero (f->display.x, sizeof (struct x_display));
01f1ba30 1888
eb8c3be9 1889 /* Some temporary default values for height and width. */
01f1ba30
JB
1890 width = 80;
1891 height = 40;
f676886a
JB
1892 f->display.x->left_pos = -1;
1893 f->display.x->top_pos = -1;
01f1ba30 1894
f676886a 1895 /* Give the frame a default name (which may be overridden with PARMS). */
01f1ba30
JB
1896
1897 strncpy (iconidentity, ICONTAG, MAXICID);
1898 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
1899 (MAXICID - 1) - sizeof (ICONTAG)))
1900 iconidentity[sizeof (ICONTAG) - 2] = '\0';
f676886a 1901 f->name = build_string (iconidentity);
01f1ba30
JB
1902
1903 /* Extract some window parameters from the supplied values.
1904 These are the parameters that affect window geometry. */
1905
cf177271 1906 tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
f9942c9e 1907 if (EQ (tem, Qunbound))
01f1ba30 1908 tem = build_string ("9x15");
f9942c9e
JB
1909 x_set_font (f, tem, Qnil);
1910 x_default_parameter (f, parms, Qborder_color,
cf177271 1911 build_string ("black"), "Border", 0, string);
f9942c9e 1912 x_default_parameter (f, parms, Qbackground_color,
cf177271 1913 build_string ("white"), "Background", 0, string);
f9942c9e 1914 x_default_parameter (f, parms, Qforeground_color,
cf177271 1915 build_string ("black"), "Foreground", 0, string);
f9942c9e 1916 x_default_parameter (f, parms, Qmouse_color,
cf177271 1917 build_string ("black"), "Mouse", 0, string);
f9942c9e 1918 x_default_parameter (f, parms, Qcursor_color,
cf177271 1919 build_string ("black"), "Cursor", 0, string);
f9942c9e 1920 x_default_parameter (f, parms, Qborder_width,
cf177271 1921 make_number (2), "BorderWidth", 0, number);
f9942c9e 1922 x_default_parameter (f, parms, Qinternal_border_width,
cf177271 1923 make_number (4), "InternalBorderWidth", 0, number);
f9942c9e 1924 x_default_parameter (f, parms, Qauto_raise,
cf177271 1925 Qnil, "AutoRaise", 0, boolean);
01f1ba30 1926
cf177271
JB
1927 hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
1928 vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
01f1ba30 1929
f676886a
JB
1930 if (f->display.x->internal_border_width < 0)
1931 f->display.x->internal_border_width = 0;
01f1ba30 1932
cf177271 1933 tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
f9942c9e 1934 if (!EQ (tem, Qunbound))
01f1ba30
JB
1935 {
1936 WINDOWINFO_TYPE wininfo;
1937 int nchildren;
1938 Window *children, root;
1939
f9942c9e 1940 CHECK_NUMBER (tem, 0);
fe24a618 1941 FRAME_X_WINDOW (f) = (Window) XINT (tem);
01f1ba30
JB
1942
1943 BLOCK_INPUT;
fe24a618
JB
1944 XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
1945 XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
9ac0d9e0 1946 xfree (children);
01f1ba30
JB
1947 UNBLOCK_INPUT;
1948
cf177271
JB
1949 height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
1950 width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
f676886a
JB
1951 f->display.x->left_pos = wininfo.x;
1952 f->display.x->top_pos = wininfo.y;
179956b9 1953 FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
f676886a
JB
1954 f->display.x->border_width = wininfo.bdrwidth;
1955 f->display.x->parent_desc = parent;
01f1ba30
JB
1956 }
1957 else
1958 {
cf177271 1959 tem = x_get_arg (parms, Qparent_id, 0, 0, number);
f9942c9e 1960 if (!EQ (tem, Qunbound))
01f1ba30 1961 {
f9942c9e
JB
1962 CHECK_NUMBER (tem, 0);
1963 parent = (Window) XINT (tem);
01f1ba30 1964 }
f676886a 1965 f->display.x->parent_desc = parent;
cf177271 1966 tem = x_get_arg (parms, Qheight, 0, 0, number);
f9942c9e 1967 if (EQ (tem, Qunbound))
01f1ba30 1968 {
cf177271 1969 tem = x_get_arg (parms, Qwidth, 0, 0, number);
f9942c9e 1970 if (EQ (tem, Qunbound))
01f1ba30 1971 {
cf177271 1972 tem = x_get_arg (parms, Qtop, 0, 0, number);
f9942c9e 1973 if (EQ (tem, Qunbound))
cf177271 1974 tem = x_get_arg (parms, Qleft, 0, 0, number);
01f1ba30
JB
1975 }
1976 }
f9942c9e 1977 /* Now TEM is Qunbound if no edge or size was specified.
01f1ba30 1978 In that case, we must do rubber-banding. */
f9942c9e 1979 if (EQ (tem, Qunbound))
01f1ba30 1980 {
cf177271 1981 tem = x_get_arg (parms, Qgeometry, 0, 0, number);
f676886a
JB
1982 x_rubber_band (f,
1983 &f->display.x->left_pos, &f->display.x->top_pos,
01f1ba30
JB
1984 &width, &height,
1985 (XTYPE (tem) == Lisp_String
1986 ? (char *) XSTRING (tem)->data : ""),
f676886a 1987 XSTRING (f->name)->data,
265a9e55 1988 !NILP (hscroll), !NILP (vscroll));
01f1ba30
JB
1989 }
1990 else
1991 {
1992 /* Here if at least one edge or size was specified.
1993 Demand that they all were specified, and use them. */
cf177271 1994 tem = x_get_arg (parms, Qheight, 0, 0, number);
f9942c9e 1995 if (EQ (tem, Qunbound))
01f1ba30
JB
1996 error ("Height not specified");
1997 CHECK_NUMBER (tem, 0);
1998 height = XINT (tem);
1999
cf177271 2000 tem = x_get_arg (parms, Qwidth, 0, 0, number);
f9942c9e 2001 if (EQ (tem, Qunbound))
01f1ba30
JB
2002 error ("Width not specified");
2003 CHECK_NUMBER (tem, 0);
2004 width = XINT (tem);
2005
cf177271 2006 tem = x_get_arg (parms, Qtop, 0, 0, number);
f9942c9e 2007 if (EQ (tem, Qunbound))
01f1ba30
JB
2008 error ("Top position not specified");
2009 CHECK_NUMBER (tem, 0);
f676886a 2010 f->display.x->left_pos = XINT (tem);
01f1ba30 2011
cf177271 2012 tem = x_get_arg (parms, Qleft, 0, 0, number);
f9942c9e 2013 if (EQ (tem, Qunbound))
01f1ba30
JB
2014 error ("Left position not specified");
2015 CHECK_NUMBER (tem, 0);
f676886a 2016 f->display.x->top_pos = XINT (tem);
01f1ba30
JB
2017 }
2018
cf177271
JB
2019 pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
2020 pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
01f1ba30
JB
2021
2022 BLOCK_INPUT;
fe24a618 2023 FRAME_X_WINDOW (f)
01f1ba30 2024 = XCreateWindow (parent,
f676886a
JB
2025 f->display.x->left_pos, /* Absolute horizontal offset */
2026 f->display.x->top_pos, /* Absolute Vertical offset */
01f1ba30 2027 pixelwidth, pixelheight,
f676886a 2028 f->display.x->border_width,
01f1ba30
JB
2029 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
2030 UNBLOCK_INPUT;
fe24a618 2031 if (FRAME_X_WINDOW (f) == 0)
01f1ba30
JB
2032 error ("Unable to create window.");
2033 }
2034
2035 /* Install the now determined height and width
2036 in the windows and in phys_lines and desired_lines. */
f9942c9e 2037 change_frame_size (f, height, width, 1, 0);
fe24a618 2038 XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
01f1ba30
JB
2039 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2040 | EnterWindow | LeaveWindow | UnmapWindow );
f676886a 2041 x_set_resize_hint (f);
01f1ba30
JB
2042
2043 /* Tell the server the window's default name. */
fe24a618 2044 XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
1113d9db 2045
01f1ba30
JB
2046 /* Now override the defaults with all the rest of the specified
2047 parms. */
cf177271 2048 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
f676886a 2049 f->no_split = minibuffer_only || EQ (tem, Qt);
01f1ba30 2050
8af1d7ca
JB
2051 /* Do not create an icon window if the caller says not to */
2052 if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
2053 || f->display.x->parent_desc != ROOT_WINDOW)
2054 {
2055 x_text_icon (f, iconidentity);
2056 x_default_parameter (f, parms, Qicon_type, Qnil,
2057 "BitmapIcon", 0, symbol);
2058 }
01f1ba30
JB
2059
2060 /* Tell the X server the previously set values of the
2061 background, border and mouse colors; also create the mouse cursor. */
2062 BLOCK_INPUT;
f676886a 2063 temp = XMakeTile (f->display.x->background_pixel);
fe24a618 2064 XChangeBackground (FRAME_X_WINDOW (f), temp);
01f1ba30
JB
2065 XFreePixmap (temp);
2066 UNBLOCK_INPUT;
f676886a 2067 x_set_border_pixel (f, f->display.x->border_pixel);
01f1ba30 2068
f676886a 2069 x_set_mouse_color (f, Qnil, Qnil);
01f1ba30
JB
2070
2071 /* Now override the defaults with all the rest of the specified parms. */
2072
f676886a 2073 Fmodify_frame_parameters (frame, parms);
01f1ba30 2074
f676886a 2075 /* Make the window appear on the frame and enable display. */
49795535
JB
2076 {
2077 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2078
2079 if (EQ (visibility, Qunbound))
2080 visibility = Qt;
2081
2082 if (! EQ (visibility, Qicon)
2083 && ! NILP (visibility))
2084 x_make_window_visible (f);
2085 }
01f1ba30 2086
cf177271 2087 SET_FRAME_GARBAGED (f);
01f1ba30 2088
f676886a 2089 return frame;
01f1ba30
JB
2090#endif /* X10 */
2091}
2092
f676886a
JB
2093DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2094 "Set the focus on FRAME.")
2095 (frame)
2096 Lisp_Object frame;
01f1ba30 2097{
f676886a 2098 CHECK_LIVE_FRAME (frame, 0);
01f1ba30 2099
f9942c9e 2100 if (FRAME_X_P (XFRAME (frame)))
01f1ba30
JB
2101 {
2102 BLOCK_INPUT;
f676886a 2103 x_focus_on_frame (XFRAME (frame));
01f1ba30 2104 UNBLOCK_INPUT;
f676886a 2105 return frame;
01f1ba30
JB
2106 }
2107
2108 return Qnil;
2109}
2110
f676886a
JB
2111DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2112 "If a frame has been focused, release it.")
01f1ba30
JB
2113 ()
2114{
f676886a 2115 if (x_focus_frame)
01f1ba30
JB
2116 {
2117 BLOCK_INPUT;
f676886a 2118 x_unfocus_frame (x_focus_frame);
01f1ba30
JB
2119 UNBLOCK_INPUT;
2120 }
2121
2122 return Qnil;
2123}
2124\f
2125#ifndef HAVE_X11
2126/* Computes an X-window size and position either from geometry GEO
2127 or with the mouse.
2128
f676886a 2129 F is a frame. It specifies an X window which is used to
01f1ba30
JB
2130 determine which display to compute for. Its font, borders
2131 and colors control how the rectangle will be displayed.
2132
2133 X and Y are where to store the positions chosen.
2134 WIDTH and HEIGHT are where to store the sizes chosen.
2135
2136 GEO is the geometry that may specify some of the info.
2137 STR is a prompt to display.
2138 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2139
2140int
f676886a
JB
2141x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
2142 struct frame *f;
01f1ba30
JB
2143 int *x, *y, *width, *height;
2144 char *geo;
2145 char *str;
2146 int hscroll, vscroll;
2147{
2148 OpaqueFrame frame;
2149 Window tempwindow;
2150 WindowInfo wininfo;
2151 int border_color;
2152 int background_color;
2153 Lisp_Object tem;
2154 int mask;
2155
2156 BLOCK_INPUT;
2157
f676886a
JB
2158 background_color = f->display.x->background_pixel;
2159 border_color = f->display.x->border_pixel;
01f1ba30 2160
f676886a 2161 frame.bdrwidth = f->display.x->border_width;
01f1ba30
JB
2162 frame.border = XMakeTile (border_color);
2163 frame.background = XMakeTile (background_color);
2164 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
f676886a 2165 (2 * f->display.x->internal_border_width
01f1ba30 2166 + (vscroll ? VSCROLL_WIDTH : 0)),
f676886a 2167 (2 * f->display.x->internal_border_width
01f1ba30 2168 + (hscroll ? HSCROLL_HEIGHT : 0)),
f676886a
JB
2169 width, height, f->display.x->font,
2170 FONT_WIDTH (f->display.x->font),
2171 FONT_HEIGHT (f->display.x->font));
01f1ba30
JB
2172 XFreePixmap (frame.border);
2173 XFreePixmap (frame.background);
2174
2175 if (tempwindow != 0)
2176 {
2177 XQueryWindow (tempwindow, &wininfo);
2178 XDestroyWindow (tempwindow);
2179 *x = wininfo.x;
2180 *y = wininfo.y;
2181 }
2182
2183 /* Coordinates we got are relative to the root window.
2184 Convert them to coordinates relative to desired parent window
2185 by scanning from there up to the root. */
f676886a 2186 tempwindow = f->display.x->parent_desc;
01f1ba30
JB
2187 while (tempwindow != ROOT_WINDOW)
2188 {
2189 int nchildren;
2190 Window *children;
2191 XQueryWindow (tempwindow, &wininfo);
2192 *x -= wininfo.x;
2193 *y -= wininfo.y;
2194 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
9ac0d9e0 2195 xfree (children);
01f1ba30
JB
2196 }
2197
2198 UNBLOCK_INPUT;
2199 return tempwindow != 0;
2200}
2201#endif /* not HAVE_X11 */
2202\f
f0614854
JB
2203DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
2204 "Return a list of the names of available fonts matching PATTERN.\n\
2205If optional arguments FACE and FRAME are specified, return only fonts\n\
2206the same size as FACE on FRAME.\n\
2207\n\
2208PATTERN is a string, perhaps with wildcard characters;\n\
2209 the * character matches any substring, and\n\
2210 the ? character matches any single character.\n\
2211 PATTERN is case-insensitive.\n\
2212FACE is a face name - a symbol.\n\
2213\n\
2214The return value is a list of strings, suitable as arguments to\n\
2215set-face-font.\n\
2216\n\
2217The list does not include fonts Emacs can't use (i.e. proportional\n\
2218fonts), even if they match PATTERN and FACE.")
2219 (pattern, face, frame)
2220 Lisp_Object pattern, face, frame;
2221{
2222 int num_fonts;
2223 char **names;
2224 XFontStruct *info;
2225 XFontStruct *size_ref;
2226 Lisp_Object list;
2227
2228 CHECK_STRING (pattern, 0);
2229 if (!NILP (face))
2230 CHECK_SYMBOL (face, 1);
2231 if (!NILP (frame))
739f2f53 2232 CHECK_LIVE_FRAME (frame, 2);
f0614854
JB
2233
2234 if (NILP (face))
2235 size_ref = 0;
2236 else
2237 {
2238 FRAME_PTR f = NILP (frame) ? selected_frame : XFRAME (frame);
2239 int face_id = face_name_id_number (f, face);
2240
a081bd37
JB
2241 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
2242 || FRAME_PARAM_FACES (f) [face_id] == 0)
ea96210c 2243 size_ref = f->display.x->font;
6998a3b4
RS
2244 else
2245 {
a081bd37 2246 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
6998a3b4
RS
2247 if (size_ref == (XFontStruct *) (~0))
2248 size_ref = f->display.x->font;
2249 }
f0614854
JB
2250 }
2251
2252 BLOCK_INPUT;
2253 names = XListFontsWithInfo (x_current_display,
2254 XSTRING (pattern)->data,
ea96210c 2255 2000, /* maxnames */
f0614854
JB
2256 &num_fonts, /* count_return */
2257 &info); /* info_return */
2258 UNBLOCK_INPUT;
2259
a9107360 2260 list = Qnil;
f0614854 2261
a9107360
RS
2262 if (names)
2263 {
2264 Lisp_Object *tail;
2265 int i;
2266
2267 tail = &list;
2268 for (i = 0; i < num_fonts; i++)
2269 if (! size_ref
2270 || same_size_fonts (&info[i], size_ref))
2271 {
2272 *tail = Fcons (build_string (names[i]), Qnil);
2273 tail = &XCONS (*tail)->cdr;
2274 }
2275
2276 XFreeFontInfo (names, info, num_fonts);
2277 }
f0614854
JB
2278
2279 return list;
2280}
2281
2282\f
8af1d7ca 2283DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0,
01f1ba30
JB
2284 "Return t if the current X display supports the color named COLOR.")
2285 (color)
2286 Lisp_Object color;
2287{
2288 Color foo;
2289
11ae94fe 2290 check_x ();
01f1ba30
JB
2291 CHECK_STRING (color, 0);
2292
2293 if (defined_color (XSTRING (color)->data, &foo))
2294 return Qt;
2295 else
2296 return Qnil;
2297}
2298
bcc426b4
RS
2299DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0,
2300 "Return t if the X screen currently in use supports color.")
01f1ba30
JB
2301 ()
2302{
11ae94fe
RS
2303 check_x ();
2304
a6605e5c 2305 if (x_screen_planes <= 2)
01f1ba30
JB
2306 return Qnil;
2307
2308 switch (screen_visual->class)
2309 {
2310 case StaticColor:
2311 case PseudoColor:
2312 case TrueColor:
2313 case DirectColor:
2314 return Qt;
2315
2316 default:
2317 return Qnil;
2318 }
2319}
2320
41beb8fc
RS
2321DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2322 0, 1, 0,
2323 "Returns the width in pixels of the display FRAME is on.")
2324 (frame)
2325 Lisp_Object frame;
2326{
2327 Display *dpy = x_current_display;
11ae94fe 2328 check_x ();
41beb8fc
RS
2329 return make_number (DisplayWidth (dpy, DefaultScreen (dpy)));
2330}
2331
2332DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2333 Sx_display_pixel_height, 0, 1, 0,
2334 "Returns the height in pixels of the display FRAME is on.")
2335 (frame)
2336 Lisp_Object frame;
2337{
2338 Display *dpy = x_current_display;
11ae94fe 2339 check_x ();
41beb8fc
RS
2340 return make_number (DisplayHeight (dpy, DefaultScreen (dpy)));
2341}
2342
2343DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2344 0, 1, 0,
2345 "Returns the number of bitplanes of the display FRAME is on.")
2346 (frame)
2347 Lisp_Object frame;
2348{
2349 Display *dpy = x_current_display;
11ae94fe 2350 check_x ();
41beb8fc
RS
2351 return make_number (DisplayPlanes (dpy, DefaultScreen (dpy)));
2352}
2353
2354DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2355 0, 1, 0,
2356 "Returns the number of color cells of the display FRAME is on.")
2357 (frame)
2358 Lisp_Object frame;
2359{
2360 Display *dpy = x_current_display;
11ae94fe 2361 check_x ();
41beb8fc
RS
2362 return make_number (DisplayCells (dpy, DefaultScreen (dpy)));
2363}
2364
2365DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
2366 "Returns the vendor ID string of the X server FRAME is on.")
2367 (frame)
2368 Lisp_Object frame;
2369{
2370 Display *dpy = x_current_display;
2371 char *vendor;
11ae94fe 2372 check_x ();
41beb8fc
RS
2373 vendor = ServerVendor (dpy);
2374 if (! vendor) vendor = "";
2375 return build_string (vendor);
2376}
2377
2378DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
2379 "Returns the version numbers of the X server in use.\n\
2380The value is a list of three integers: the major and minor\n\
2381version numbers of the X Protocol in use, and the vendor-specific release\n\
2382number. See also the variable `x-server-vendor'.")
2383 (frame)
2384 Lisp_Object frame;
2385{
2386 Display *dpy = x_current_display;
11ae94fe
RS
2387
2388 check_x ();
41beb8fc
RS
2389 return Fcons (make_number (ProtocolVersion (dpy)),
2390 Fcons (make_number (ProtocolRevision (dpy)),
2391 Fcons (make_number (VendorRelease (dpy)), Qnil)));
2392}
2393
2394DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
2395 "Returns the number of screens on the X server FRAME is on.")
2396 (frame)
2397 Lisp_Object frame;
2398{
11ae94fe 2399 check_x ();
41beb8fc
RS
2400 return make_number (ScreenCount (x_current_display));
2401}
2402
2403DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
2404 "Returns the height in millimeters of the X screen FRAME is on.")
2405 (frame)
2406 Lisp_Object frame;
2407{
11ae94fe 2408 check_x ();
41beb8fc
RS
2409 return make_number (HeightMMOfScreen (x_screen));
2410}
2411
2412DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
2413 "Returns the width in millimeters of the X screen FRAME is on.")
2414 (frame)
2415 Lisp_Object frame;
2416{
11ae94fe 2417 check_x ();
41beb8fc
RS
2418 return make_number (WidthMMOfScreen (x_screen));
2419}
2420
2421DEFUN ("x-display-backing-store", Fx_display_backing_store,
2422 Sx_display_backing_store, 0, 1, 0,
2423 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2424The value may be `always', `when-mapped', or `not-useful'.")
2425 (frame)
2426 Lisp_Object frame;
2427{
11ae94fe
RS
2428 check_x ();
2429
41beb8fc
RS
2430 switch (DoesBackingStore (x_screen))
2431 {
2432 case Always:
2433 return intern ("always");
2434
2435 case WhenMapped:
2436 return intern ("when-mapped");
2437
2438 case NotUseful:
2439 return intern ("not-useful");
2440
2441 default:
2442 error ("Strange value for BackingStore parameter of screen");
2443 }
2444}
2445
2446DEFUN ("x-display-visual-class", Fx_display_visual_class,
2447 Sx_display_visual_class, 0, 1, 0,
2448 "Returns the visual class of the display `screen' is on.\n\
2449The value is one of the symbols `static-gray', `gray-scale',\n\
2450`static-color', `pseudo-color', `true-color', or `direct-color'.")
2451 (screen)
2452 Lisp_Object screen;
2453{
11ae94fe
RS
2454 check_x ();
2455
41beb8fc
RS
2456 switch (screen_visual->class)
2457 {
2458 case StaticGray: return (intern ("static-gray"));
2459 case GrayScale: return (intern ("gray-scale"));
2460 case StaticColor: return (intern ("static-color"));
2461 case PseudoColor: return (intern ("pseudo-color"));
2462 case TrueColor: return (intern ("true-color"));
2463 case DirectColor: return (intern ("direct-color"));
2464 default:
2465 error ("Display has an unknown visual class");
2466 }
2467}
2468
2469DEFUN ("x-display-save-under", Fx_display_save_under,
2470 Sx_display_save_under, 0, 1, 0,
2471 "Returns t if the X screen FRAME is on supports the save-under feature.")
2472 (frame)
2473 Lisp_Object frame;
2474{
11ae94fe
RS
2475 check_x ();
2476
41beb8fc
RS
2477 if (DoesSaveUnders (x_screen) == True)
2478 return Qt;
2479 else
2480 return Qnil;
2481}
2482\f
55caf99c
RS
2483x_pixel_width (f)
2484 register struct frame *f;
01f1ba30 2485{
55caf99c 2486 return PIXEL_WIDTH (f);
01f1ba30
JB
2487}
2488
55caf99c
RS
2489x_pixel_height (f)
2490 register struct frame *f;
01f1ba30 2491{
55caf99c
RS
2492 return PIXEL_HEIGHT (f);
2493}
2494
2495x_char_width (f)
2496 register struct frame *f;
2497{
2498 return FONT_WIDTH (f->display.x->font);
2499}
2500
2501x_char_height (f)
2502 register struct frame *f;
2503{
2504 return FONT_HEIGHT (f->display.x->font);
01f1ba30
JB
2505}
2506\f
85ffea93
RS
2507#if 0 /* These no longer seem like the right way to do things. */
2508
f676886a 2509/* Draw a rectangle on the frame with left top corner including
01f1ba30
JB
2510 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2511 CHARS by LINES wide and long and is the color of the cursor. */
2512
2513void
f676886a
JB
2514x_rectangle (f, gc, left_char, top_char, chars, lines)
2515 register struct frame *f;
01f1ba30
JB
2516 GC gc;
2517 register int top_char, left_char, chars, lines;
2518{
2519 int width;
2520 int height;
f676886a
JB
2521 int left = (left_char * FONT_WIDTH (f->display.x->font)
2522 + f->display.x->internal_border_width);
2523 int top = (top_char * FONT_HEIGHT (f->display.x->font)
2524 + f->display.x->internal_border_width);
01f1ba30
JB
2525
2526 if (chars < 0)
f676886a 2527 width = FONT_WIDTH (f->display.x->font) / 2;
01f1ba30 2528 else
f676886a 2529 width = FONT_WIDTH (f->display.x->font) * chars;
01f1ba30 2530 if (lines < 0)
f676886a 2531 height = FONT_HEIGHT (f->display.x->font) / 2;
01f1ba30 2532 else
f676886a 2533 height = FONT_HEIGHT (f->display.x->font) * lines;
01f1ba30 2534
fe24a618 2535 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
2536 gc, left, top, width, height);
2537}
2538
2539DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
f676886a 2540 "Draw a rectangle on FRAME between coordinates specified by\n\
01f1ba30 2541numbers X0, Y0, X1, Y1 in the cursor pixel.")
f676886a
JB
2542 (frame, X0, Y0, X1, Y1)
2543 register Lisp_Object frame, X0, X1, Y0, Y1;
01f1ba30
JB
2544{
2545 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2546
f676886a 2547 CHECK_LIVE_FRAME (frame, 0);
01f1ba30
JB
2548 CHECK_NUMBER (X0, 0);
2549 CHECK_NUMBER (Y0, 1);
2550 CHECK_NUMBER (X1, 2);
2551 CHECK_NUMBER (Y1, 3);
2552
2553 x0 = XINT (X0);
2554 x1 = XINT (X1);
2555 y0 = XINT (Y0);
2556 y1 = XINT (Y1);
2557
2558 if (y1 > y0)
2559 {
2560 top = y0;
2561 n_lines = y1 - y0 + 1;
2562 }
2563 else
2564 {
2565 top = y1;
2566 n_lines = y0 - y1 + 1;
2567 }
2568
2569 if (x1 > x0)
2570 {
2571 left = x0;
2572 n_chars = x1 - x0 + 1;
2573 }
2574 else
2575 {
2576 left = x1;
2577 n_chars = x0 - x1 + 1;
2578 }
2579
2580 BLOCK_INPUT;
f676886a 2581 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
01f1ba30
JB
2582 left, top, n_chars, n_lines);
2583 UNBLOCK_INPUT;
2584
2585 return Qt;
2586}
2587
2588DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
f676886a 2589 "Draw a rectangle drawn on FRAME between coordinates\n\
01f1ba30 2590X0, Y0, X1, Y1 in the regular background-pixel.")
f676886a
JB
2591 (frame, X0, Y0, X1, Y1)
2592 register Lisp_Object frame, X0, Y0, X1, Y1;
01f1ba30
JB
2593{
2594 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2595
f676886a 2596 CHECK_FRAME (frame, 0);
01f1ba30
JB
2597 CHECK_NUMBER (X0, 0);
2598 CHECK_NUMBER (Y0, 1);
2599 CHECK_NUMBER (X1, 2);
2600 CHECK_NUMBER (Y1, 3);
2601
2602 x0 = XINT (X0);
2603 x1 = XINT (X1);
2604 y0 = XINT (Y0);
2605 y1 = XINT (Y1);
2606
2607 if (y1 > y0)
2608 {
2609 top = y0;
2610 n_lines = y1 - y0 + 1;
2611 }
2612 else
2613 {
2614 top = y1;
2615 n_lines = y0 - y1 + 1;
2616 }
2617
2618 if (x1 > x0)
2619 {
2620 left = x0;
2621 n_chars = x1 - x0 + 1;
2622 }
2623 else
2624 {
2625 left = x1;
2626 n_chars = x0 - x1 + 1;
2627 }
2628
2629 BLOCK_INPUT;
f676886a 2630 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
01f1ba30
JB
2631 left, top, n_chars, n_lines);
2632 UNBLOCK_INPUT;
2633
2634 return Qt;
2635}
2636
2637/* Draw lines around the text region beginning at the character position
2638 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
2639 pixel and line characteristics. */
2640
f676886a 2641#define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
01f1ba30
JB
2642
2643static void
f676886a
JB
2644outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
2645 register struct frame *f;
01f1ba30
JB
2646 GC gc;
2647 int top_x, top_y, bottom_x, bottom_y;
2648{
f676886a
JB
2649 register int ibw = f->display.x->internal_border_width;
2650 register int font_w = FONT_WIDTH (f->display.x->font);
2651 register int font_h = FONT_HEIGHT (f->display.x->font);
01f1ba30
JB
2652 int y = top_y;
2653 int x = line_len (y);
2654 XPoint *pixel_points = (XPoint *)
2655 alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
2656 register XPoint *this_point = pixel_points;
2657
2658 /* Do the horizontal top line/lines */
2659 if (top_x == 0)
2660 {
2661 this_point->x = ibw;
2662 this_point->y = ibw + (font_h * top_y);
2663 this_point++;
2664 if (x == 0)
2665 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
2666 else
2667 this_point->x = ibw + (font_w * x);
2668 this_point->y = (this_point - 1)->y;
2669 }
2670 else
2671 {
2672 this_point->x = ibw;
2673 this_point->y = ibw + (font_h * (top_y + 1));
2674 this_point++;
2675 this_point->x = ibw + (font_w * top_x);
2676 this_point->y = (this_point - 1)->y;
2677 this_point++;
2678 this_point->x = (this_point - 1)->x;
2679 this_point->y = ibw + (font_h * top_y);
2680 this_point++;
2681 this_point->x = ibw + (font_w * x);
2682 this_point->y = (this_point - 1)->y;
2683 }
2684
2685 /* Now do the right side. */
2686 while (y < bottom_y)
2687 { /* Right vertical edge */
2688 this_point++;
2689 this_point->x = (this_point - 1)->x;
2690 this_point->y = ibw + (font_h * (y + 1));
2691 this_point++;
2692
2693 y++; /* Horizontal connection to next line */
2694 x = line_len (y);
2695 if (x == 0)
2696 this_point->x = ibw + (font_w / 2);
2697 else
2698 this_point->x = ibw + (font_w * x);
2699
2700 this_point->y = (this_point - 1)->y;
2701 }
2702
2703 /* Now do the bottom and connect to the top left point. */
2704 this_point->x = ibw + (font_w * (bottom_x + 1));
2705
2706 this_point++;
2707 this_point->x = (this_point - 1)->x;
2708 this_point->y = ibw + (font_h * (bottom_y + 1));
2709 this_point++;
2710 this_point->x = ibw;
2711 this_point->y = (this_point - 1)->y;
2712 this_point++;
2713 this_point->x = pixel_points->x;
2714 this_point->y = pixel_points->y;
2715
fe24a618 2716 XDrawLines (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
2717 gc, pixel_points,
2718 (this_point - pixel_points + 1), CoordModeOrigin);
2719}
2720
2721DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
2722 "Highlight the region between point and the character under the mouse\n\
f676886a 2723selected frame.")
01f1ba30
JB
2724 (event)
2725 register Lisp_Object event;
2726{
2727 register int x0, y0, x1, y1;
f676886a 2728 register struct frame *f = selected_frame;
01f1ba30
JB
2729 register int p1, p2;
2730
2731 CHECK_CONS (event, 0);
2732
2733 BLOCK_INPUT;
2734 x0 = XINT (Fcar (Fcar (event)));
2735 y0 = XINT (Fcar (Fcdr (Fcar (event))));
2736
2737 /* If the mouse is past the end of the line, don't that area. */
2738 /* ReWrite this... */
2739
f676886a
JB
2740 x1 = f->cursor_x;
2741 y1 = f->cursor_y;
01f1ba30
JB
2742
2743 if (y1 > y0) /* point below mouse */
f676886a 2744 outline_region (f, f->display.x->cursor_gc,
01f1ba30
JB
2745 x0, y0, x1, y1);
2746 else if (y1 < y0) /* point above mouse */
f676886a 2747 outline_region (f, f->display.x->cursor_gc,
01f1ba30
JB
2748 x1, y1, x0, y0);
2749 else /* same line: draw horizontal rectangle */
2750 {
2751 if (x1 > x0)
f676886a 2752 x_rectangle (f, f->display.x->cursor_gc,
01f1ba30
JB
2753 x0, y0, (x1 - x0 + 1), 1);
2754 else if (x1 < x0)
f676886a 2755 x_rectangle (f, f->display.x->cursor_gc,
01f1ba30
JB
2756 x1, y1, (x0 - x1 + 1), 1);
2757 }
2758
2759 XFlush (x_current_display);
2760 UNBLOCK_INPUT;
2761
2762 return Qnil;
2763}
2764
2765DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
2766 "Erase any highlighting of the region between point and the character\n\
f676886a 2767at X, Y on the selected frame.")
01f1ba30
JB
2768 (event)
2769 register Lisp_Object event;
2770{
2771 register int x0, y0, x1, y1;
f676886a 2772 register struct frame *f = selected_frame;
01f1ba30
JB
2773
2774 BLOCK_INPUT;
2775 x0 = XINT (Fcar (Fcar (event)));
2776 y0 = XINT (Fcar (Fcdr (Fcar (event))));
f676886a
JB
2777 x1 = f->cursor_x;
2778 y1 = f->cursor_y;
01f1ba30
JB
2779
2780 if (y1 > y0) /* point below mouse */
f676886a 2781 outline_region (f, f->display.x->reverse_gc,
01f1ba30
JB
2782 x0, y0, x1, y1);
2783 else if (y1 < y0) /* point above mouse */
f676886a 2784 outline_region (f, f->display.x->reverse_gc,
01f1ba30
JB
2785 x1, y1, x0, y0);
2786 else /* same line: draw horizontal rectangle */
2787 {
2788 if (x1 > x0)
f676886a 2789 x_rectangle (f, f->display.x->reverse_gc,
01f1ba30
JB
2790 x0, y0, (x1 - x0 + 1), 1);
2791 else if (x1 < x0)
f676886a 2792 x_rectangle (f, f->display.x->reverse_gc,
01f1ba30
JB
2793 x1, y1, (x0 - x1 + 1), 1);
2794 }
2795 UNBLOCK_INPUT;
2796
2797 return Qnil;
2798}
2799
01f1ba30
JB
2800#if 0
2801int contour_begin_x, contour_begin_y;
2802int contour_end_x, contour_end_y;
2803int contour_npoints;
2804
2805/* Clip the top part of the contour lines down (and including) line Y_POS.
2806 If X_POS is in the middle (rather than at the end) of the line, drop
2807 down a line at that character. */
2808
2809static void
2810clip_contour_top (y_pos, x_pos)
2811{
2812 register XPoint *begin = contour_lines[y_pos].top_left;
2813 register XPoint *end;
2814 register int npoints;
f676886a 2815 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
01f1ba30
JB
2816
2817 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
2818 {
2819 end = contour_lines[y_pos].top_right;
2820 npoints = (end - begin + 1);
2821 XDrawLines (x_current_display, contour_window,
2822 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2823
2824 bcopy (end, begin + 1, contour_last_point - end + 1);
2825 contour_last_point -= (npoints - 2);
2826 XDrawLines (x_current_display, contour_window,
2827 contour_erase_gc, begin, 2, CoordModeOrigin);
2828 XFlush (x_current_display);
2829
2830 /* Now, update contour_lines structure. */
2831 }
2832 /* ______. */
2833 else /* |________*/
2834 {
2835 register XPoint *p = begin + 1;
2836 end = contour_lines[y_pos].bottom_right;
2837 npoints = (end - begin + 1);
2838 XDrawLines (x_current_display, contour_window,
2839 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
2840
2841 p->y = begin->y;
2842 p->x = ibw + (font_w * (x_pos + 1));
2843 p++;
2844 p->y = begin->y + font_h;
2845 p->x = (p - 1)->x;
2846 bcopy (end, begin + 3, contour_last_point - end + 1);
2847 contour_last_point -= (npoints - 5);
2848 XDrawLines (x_current_display, contour_window,
2849 contour_erase_gc, begin, 4, CoordModeOrigin);
2850 XFlush (x_current_display);
2851
2852 /* Now, update contour_lines structure. */
2853 }
2854}
2855
eb8c3be9 2856/* Erase the top horizontal lines of the contour, and then extend
01f1ba30
JB
2857 the contour upwards. */
2858
2859static void
2860extend_contour_top (line)
2861{
2862}
2863
2864static void
2865clip_contour_bottom (x_pos, y_pos)
2866 int x_pos, y_pos;
2867{
2868}
2869
2870static void
2871extend_contour_bottom (x_pos, y_pos)
2872{
2873}
2874
2875DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
2876 "")
2877 (event)
2878 Lisp_Object event;
2879{
f676886a
JB
2880 register struct frame *f = selected_frame;
2881 register int point_x = f->cursor_x;
2882 register int point_y = f->cursor_y;
01f1ba30
JB
2883 register int mouse_below_point;
2884 register Lisp_Object obj;
2885 register int x_contour_x, x_contour_y;
2886
2887 x_contour_x = x_mouse_x;
2888 x_contour_y = x_mouse_y;
2889 if (x_contour_y > point_y || (x_contour_y == point_y
2890 && x_contour_x > point_x))
2891 {
2892 mouse_below_point = 1;
f676886a 2893 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
01f1ba30
JB
2894 x_contour_x, x_contour_y);
2895 }
2896 else
2897 {
2898 mouse_below_point = 0;
f676886a 2899 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
01f1ba30
JB
2900 point_x, point_y);
2901 }
2902
2903 while (1)
2904 {
95be70ed 2905 obj = read_char (-1, 0, 0, Qnil, 0);
01f1ba30
JB
2906 if (XTYPE (obj) != Lisp_Cons)
2907 break;
2908
2909 if (mouse_below_point)
2910 {
2911 if (x_mouse_y <= point_y) /* Flipped. */
2912 {
2913 mouse_below_point = 0;
2914
f676886a 2915 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
01f1ba30 2916 x_contour_x, x_contour_y);
f676886a 2917 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
01f1ba30
JB
2918 point_x, point_y);
2919 }
2920 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
2921 {
2922 clip_contour_bottom (x_mouse_y);
2923 }
2924 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
2925 {
2926 extend_bottom_contour (x_mouse_y);
2927 }
2928
2929 x_contour_x = x_mouse_x;
2930 x_contour_y = x_mouse_y;
2931 }
2932 else /* mouse above or same line as point */
2933 {
2934 if (x_mouse_y >= point_y) /* Flipped. */
2935 {
2936 mouse_below_point = 1;
2937
f676886a 2938 outline_region (f, f->display.x->reverse_gc,
01f1ba30 2939 x_contour_x, x_contour_y, point_x, point_y);
f676886a 2940 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
01f1ba30
JB
2941 x_mouse_x, x_mouse_y);
2942 }
2943 else if (x_mouse_y > x_contour_y) /* Top clipped. */
2944 {
2945 clip_contour_top (x_mouse_y);
2946 }
2947 else if (x_mouse_y < x_contour_y) /* Top extended. */
2948 {
2949 extend_contour_top (x_mouse_y);
2950 }
2951 }
2952 }
2953
b4f5687c 2954 unread_command_event = obj;
01f1ba30
JB
2955 if (mouse_below_point)
2956 {
2957 contour_begin_x = point_x;
2958 contour_begin_y = point_y;
2959 contour_end_x = x_contour_x;
2960 contour_end_y = x_contour_y;
2961 }
2962 else
2963 {
2964 contour_begin_x = x_contour_x;
2965 contour_begin_y = x_contour_y;
2966 contour_end_x = point_x;
2967 contour_end_y = point_y;
2968 }
2969}
2970#endif
2971
2972DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
2973 "")
2974 (event)
2975 Lisp_Object event;
2976{
2977 register Lisp_Object obj;
f676886a 2978 struct frame *f = selected_frame;
01f1ba30 2979 register struct window *w = XWINDOW (selected_window);
f676886a
JB
2980 register GC line_gc = f->display.x->cursor_gc;
2981 register GC erase_gc = f->display.x->reverse_gc;
01f1ba30
JB
2982#if 0
2983 char dash_list[] = {6, 4, 6, 4};
2984 int dashes = 4;
2985 XGCValues gc_values;
2986#endif
2987 register int previous_y;
f676886a
JB
2988 register int line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
2989 + f->display.x->internal_border_width;
2990 register int left = f->display.x->internal_border_width
01f1ba30 2991 + (w->left
f676886a 2992 * FONT_WIDTH (f->display.x->font));
01f1ba30 2993 register int right = left + (w->width
f676886a
JB
2994 * FONT_WIDTH (f->display.x->font))
2995 - f->display.x->internal_border_width;
01f1ba30
JB
2996
2997#if 0
2998 BLOCK_INPUT;
f676886a
JB
2999 gc_values.foreground = f->display.x->cursor_pixel;
3000 gc_values.background = f->display.x->background_pixel;
01f1ba30
JB
3001 gc_values.line_width = 1;
3002 gc_values.line_style = LineOnOffDash;
3003 gc_values.cap_style = CapRound;
3004 gc_values.join_style = JoinRound;
3005
fe24a618 3006 line_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
3007 GCLineStyle | GCJoinStyle | GCCapStyle
3008 | GCLineWidth | GCForeground | GCBackground,
3009 &gc_values);
3010 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
f676886a
JB
3011 gc_values.foreground = f->display.x->background_pixel;
3012 gc_values.background = f->display.x->foreground_pixel;
fe24a618 3013 erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
3014 GCLineStyle | GCJoinStyle | GCCapStyle
3015 | GCLineWidth | GCForeground | GCBackground,
3016 &gc_values);
3017 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
3018#endif
3019
3020 while (1)
3021 {
3022 BLOCK_INPUT;
3023 if (x_mouse_y >= XINT (w->top)
3024 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3025 {
3026 previous_y = x_mouse_y;
f676886a
JB
3027 line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
3028 + f->display.x->internal_border_width;
fe24a618 3029 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
3030 line_gc, left, line, right, line);
3031 }
3032 XFlushQueue ();
3033 UNBLOCK_INPUT;
3034
3035 do
3036 {
95be70ed 3037 obj = read_char (-1, 0, 0, Qnil, 0);
01f1ba30
JB
3038 if ((XTYPE (obj) != Lisp_Cons)
3039 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
f9942c9e 3040 Qvertical_scroll_bar))
01f1ba30
JB
3041 || x_mouse_grabbed)
3042 {
3043 BLOCK_INPUT;
fe24a618 3044 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
3045 erase_gc, left, line, right, line);
3046 UNBLOCK_INPUT;
b4f5687c 3047 unread_command_event = obj;
01f1ba30
JB
3048#if 0
3049 XFreeGC (x_current_display, line_gc);
3050 XFreeGC (x_current_display, erase_gc);
3051#endif
3052 return Qnil;
3053 }
3054 }
3055 while (x_mouse_y == previous_y);
3056
3057 BLOCK_INPUT;
fe24a618 3058 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
3059 erase_gc, left, line, right, line);
3060 UNBLOCK_INPUT;
3061 }
3062}
06ef7355 3063#endif
01f1ba30 3064\f
01f1ba30
JB
3065/* Offset in buffer of character under the pointer, or 0. */
3066int mouse_buffer_offset;
3067
3068#if 0
3069/* These keep track of the rectangle following the pointer. */
3070int mouse_track_top, mouse_track_left, mouse_track_width;
3071
3072DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3073 "Track the pointer.")
3074 ()
3075{
3076 static Cursor current_pointer_shape;
f676886a 3077 FRAME_PTR f = x_mouse_frame;
01f1ba30
JB
3078
3079 BLOCK_INPUT;
f676886a
JB
3080 if (EQ (Vmouse_frame_part, Qtext_part)
3081 && (current_pointer_shape != f->display.x->nontext_cursor))
01f1ba30
JB
3082 {
3083 unsigned char c;
3084 struct buffer *buf;
3085
f676886a 3086 current_pointer_shape = f->display.x->nontext_cursor;
01f1ba30 3087 XDefineCursor (x_current_display,
fe24a618 3088 FRAME_X_WINDOW (f),
01f1ba30
JB
3089 current_pointer_shape);
3090
3091 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3092 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3093 }
f676886a
JB
3094 else if (EQ (Vmouse_frame_part, Qmodeline_part)
3095 && (current_pointer_shape != f->display.x->modeline_cursor))
01f1ba30 3096 {
f676886a 3097 current_pointer_shape = f->display.x->modeline_cursor;
01f1ba30 3098 XDefineCursor (x_current_display,
fe24a618 3099 FRAME_X_WINDOW (f),
01f1ba30
JB
3100 current_pointer_shape);
3101 }
3102
3103 XFlushQueue ();
3104 UNBLOCK_INPUT;
3105}
3106#endif
3107
3108#if 0
3109DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3110 "Draw rectangle around character under mouse pointer, if there is one.")
3111 (event)
3112 Lisp_Object event;
3113{
3114 struct window *w = XWINDOW (Vmouse_window);
f676886a 3115 struct frame *f = XFRAME (WINDOW_FRAME (w));
01f1ba30
JB
3116 struct buffer *b = XBUFFER (w->buffer);
3117 Lisp_Object obj;
3118
3119 if (! EQ (Vmouse_window, selected_window))
3120 return Qnil;
3121
3122 if (EQ (event, Qnil))
3123 {
3124 int x, y;
3125
f676886a 3126 x_read_mouse_position (selected_frame, &x, &y);
01f1ba30
JB
3127 }
3128
3129 BLOCK_INPUT;
3130 mouse_track_width = 0;
3131 mouse_track_left = mouse_track_top = -1;
3132
3133 do
3134 {
3135 if ((x_mouse_x != mouse_track_left
3136 && (x_mouse_x < mouse_track_left
3137 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3138 || x_mouse_y != mouse_track_top)
3139 {
3140 int hp = 0; /* Horizontal position */
f676886a
JB
3141 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
3142 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
01f1ba30 3143 int tab_width = XINT (b->tab_width);
265a9e55 3144 int ctl_arrow_p = !NILP (b->ctl_arrow);
01f1ba30
JB
3145 unsigned char c;
3146 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3147 int in_mode_line = 0;
3148
f676886a 3149 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
01f1ba30
JB
3150 break;
3151
3152 /* Erase previous rectangle. */
3153 if (mouse_track_width)
3154 {
f676886a 3155 x_rectangle (f, f->display.x->reverse_gc,
01f1ba30
JB
3156 mouse_track_left, mouse_track_top,
3157 mouse_track_width, 1);
3158
f676886a
JB
3159 if ((mouse_track_left == f->phys_cursor_x
3160 || mouse_track_left == f->phys_cursor_x - 1)
3161 && mouse_track_top == f->phys_cursor_y)
01f1ba30 3162 {
f676886a 3163 x_display_cursor (f, 1);
01f1ba30
JB
3164 }
3165 }
3166
3167 mouse_track_left = x_mouse_x;
3168 mouse_track_top = x_mouse_y;
3169 mouse_track_width = 0;
3170
3171 if (mouse_track_left > len) /* Past the end of line. */
3172 goto draw_or_not;
3173
3174 if (mouse_track_top == mode_line_vpos)
3175 {
3176 in_mode_line = 1;
3177 goto draw_or_not;
3178 }
3179
3180 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3181 do
3182 {
3183 c = FETCH_CHAR (p);
f676886a 3184 if (len == f->width && hp == len - 1 && c != '\n')
01f1ba30
JB
3185 goto draw_or_not;
3186
3187 switch (c)
3188 {
3189 case '\t':
3190 mouse_track_width = tab_width - (hp % tab_width);
3191 p++;
3192 hp += mouse_track_width;
3193 if (hp > x_mouse_x)
3194 {
3195 mouse_track_left = hp - mouse_track_width;
3196 goto draw_or_not;
3197 }
3198 continue;
3199
3200 case '\n':
3201 mouse_track_width = -1;
3202 goto draw_or_not;
3203
3204 default:
3205 if (ctl_arrow_p && (c < 040 || c == 0177))
3206 {
3207 if (p > ZV)
3208 goto draw_or_not;
3209
3210 mouse_track_width = 2;
3211 p++;
3212 hp +=2;
3213 if (hp > x_mouse_x)
3214 {
3215 mouse_track_left = hp - mouse_track_width;
3216 goto draw_or_not;
3217 }
3218 }
3219 else
3220 {
3221 mouse_track_width = 1;
3222 p++;
3223 hp++;
3224 }
3225 continue;
3226 }
3227 }
3228 while (hp <= x_mouse_x);
3229
3230 draw_or_not:
3231 if (mouse_track_width) /* Over text; use text pointer shape. */
3232 {
3233 XDefineCursor (x_current_display,
fe24a618 3234 FRAME_X_WINDOW (f),
f676886a
JB
3235 f->display.x->text_cursor);
3236 x_rectangle (f, f->display.x->cursor_gc,
01f1ba30
JB
3237 mouse_track_left, mouse_track_top,
3238 mouse_track_width, 1);
3239 }
3240 else if (in_mode_line)
3241 XDefineCursor (x_current_display,
fe24a618 3242 FRAME_X_WINDOW (f),
f676886a 3243 f->display.x->modeline_cursor);
01f1ba30
JB
3244 else
3245 XDefineCursor (x_current_display,
fe24a618 3246 FRAME_X_WINDOW (f),
f676886a 3247 f->display.x->nontext_cursor);
01f1ba30
JB
3248 }
3249
3250 XFlush (x_current_display);
3251 UNBLOCK_INPUT;
3252
95be70ed 3253 obj = read_char (-1, 0, 0, Qnil, 0);
01f1ba30
JB
3254 BLOCK_INPUT;
3255 }
3256 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
a3c87d4e 3257 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
01f1ba30
JB
3258 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3259 && EQ (Vmouse_window, selected_window) /* In this window */
f676886a 3260 && x_mouse_frame);
01f1ba30 3261
b4f5687c 3262 unread_command_event = obj;
01f1ba30
JB
3263
3264 if (mouse_track_width)
3265 {
f676886a 3266 x_rectangle (f, f->display.x->reverse_gc,
01f1ba30
JB
3267 mouse_track_left, mouse_track_top,
3268 mouse_track_width, 1);
3269 mouse_track_width = 0;
f676886a
JB
3270 if ((mouse_track_left == f->phys_cursor_x
3271 || mouse_track_left - 1 == f->phys_cursor_x)
3272 && mouse_track_top == f->phys_cursor_y)
01f1ba30 3273 {
f676886a 3274 x_display_cursor (f, 1);
01f1ba30
JB
3275 }
3276 }
3277 XDefineCursor (x_current_display,
fe24a618 3278 FRAME_X_WINDOW (f),
f676886a 3279 f->display.x->nontext_cursor);
01f1ba30
JB
3280 XFlush (x_current_display);
3281 UNBLOCK_INPUT;
3282
3283 return Qnil;
3284}
3285#endif
3286\f
3287#if 0
3288#include "glyphs.h"
3289
3290/* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
f676886a 3291 on the frame F at position X, Y. */
01f1ba30 3292
f676886a
JB
3293x_draw_pixmap (f, x, y, image_data, width, height)
3294 struct frame *f;
01f1ba30
JB
3295 int x, y, width, height;
3296 char *image_data;
3297{
3298 Pixmap image;
3299
3300 image = XCreateBitmapFromData (x_current_display,
fe24a618 3301 FRAME_X_WINDOW (f), image_data,
01f1ba30 3302 width, height);
fe24a618 3303 XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f),
f676886a 3304 f->display.x->normal_gc, 0, 0, width, height, x, y);
01f1ba30
JB
3305}
3306#endif
3307\f
01f1ba30
JB
3308#ifndef HAVE_X11
3309DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3310 1, 1, "sStore text in cut buffer: ",
3311 "Store contents of STRING into the cut buffer of the X window system.")
3312 (string)
3313 register Lisp_Object string;
3314{
3315 int mask;
3316
3317 CHECK_STRING (string, 1);
f9942c9e 3318 if (! FRAME_X_P (selected_frame))
f676886a 3319 error ("Selected frame does not understand X protocol.");
01f1ba30
JB
3320
3321 BLOCK_INPUT;
3322 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3323 UNBLOCK_INPUT;
3324
3325 return Qnil;
3326}
3327
3328DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3329 "Return contents of cut buffer of the X window system, as a string.")
3330 ()
3331{
3332 int len;
3333 register Lisp_Object string;
3334 int mask;
3335 register char *d;
3336
3337 BLOCK_INPUT;
3338 d = XFetchBytes (&len);
3339 string = make_string (d, len);
3340 XFree (d);
3341 UNBLOCK_INPUT;
3342 return string;
3343}
3344#endif /* X10 */
3345\f
3346#ifdef HAVE_X11
3347DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3348"Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3349KEYSYM is a string which conforms to the X keysym definitions found\n\
3350in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3351list of strings specifying modifier keys such as Control_L, which must\n\
3352also be depressed for NEWSTRING to appear.")
3353 (x_keysym, modifiers, newstring)
3354 register Lisp_Object x_keysym;
3355 register Lisp_Object modifiers;
3356 register Lisp_Object newstring;
3357{
3358 char *rawstring;
c047688c
JA
3359 register KeySym keysym;
3360 KeySym modifier_list[16];
01f1ba30 3361
11ae94fe 3362 check_x ();
01f1ba30
JB
3363 CHECK_STRING (x_keysym, 1);
3364 CHECK_STRING (newstring, 3);
3365
3366 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3367 if (keysym == NoSymbol)
3368 error ("Keysym does not exist");
3369
265a9e55 3370 if (NILP (modifiers))
01f1ba30
JB
3371 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3372 XSTRING (newstring)->data, XSTRING (newstring)->size);
3373 else
3374 {
3375 register Lisp_Object rest, mod;
3376 register int i = 0;
3377
265a9e55 3378 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
01f1ba30
JB
3379 {
3380 if (i == 16)
3381 error ("Can't have more than 16 modifiers");
3382
3383 mod = Fcar (rest);
3384 CHECK_STRING (mod, 3);
3385 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
fb351039
JB
3386#ifndef HAVE_X11R5
3387 if (modifier_list[i] == NoSymbol
3388 || !(IsModifierKey (modifier_list[i])
3389 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
3390 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
3391#else
01f1ba30
JB
3392 if (modifier_list[i] == NoSymbol
3393 || !IsModifierKey (modifier_list[i]))
fb351039 3394#endif
01f1ba30
JB
3395 error ("Element is not a modifier keysym");
3396 i++;
3397 }
3398
3399 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3400 XSTRING (newstring)->data, XSTRING (newstring)->size);
3401 }
3402
3403 return Qnil;
3404}
3405
3406DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3407 "Rebind KEYCODE to list of strings STRINGS.\n\
3408STRINGS should be a list of 16 elements, one for each shift combination.\n\
3409nil as element means don't change.\n\
3410See the documentation of `x-rebind-key' for more information.")
3411 (keycode, strings)
3412 register Lisp_Object keycode;
3413 register Lisp_Object strings;
3414{
3415 register Lisp_Object item;
3416 register unsigned char *rawstring;
3417 KeySym rawkey, modifier[1];
3418 int strsize;
3419 register unsigned i;
3420
11ae94fe 3421 check_x ();
01f1ba30
JB
3422 CHECK_NUMBER (keycode, 1);
3423 CHECK_CONS (strings, 2);
3424 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3425 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3426 {
3427 item = Fcar (strings);
265a9e55 3428 if (!NILP (item))
01f1ba30
JB
3429 {
3430 CHECK_STRING (item, 2);
3431 strsize = XSTRING (item)->size;
3432 rawstring = (unsigned char *) xmalloc (strsize);
3433 bcopy (XSTRING (item)->data, rawstring, strsize);
3434 modifier[1] = 1 << i;
3435 XRebindKeysym (x_current_display, rawkey, modifier, 1,
3436 rawstring, strsize);
3437 }
3438 }
3439 return Qnil;
3440}
9d04a87a 3441#endif /* HAVE_X11 */
01f1ba30
JB
3442\f
3443#ifdef HAVE_X11
3444Visual *
3445select_visual (screen, depth)
3446 Screen *screen;
3447 unsigned int *depth;
3448{
3449 Visual *v;
3450 XVisualInfo *vinfo, vinfo_template;
3451 int n_visuals;
3452
3453 v = DefaultVisualOfScreen (screen);
fe24a618
JB
3454
3455#ifdef HAVE_X11R4
3456 vinfo_template.visualid = XVisualIDFromVisual (v);
3457#else
6afb1d07 3458 vinfo_template.visualid = v->visualid;
fe24a618
JB
3459#endif
3460
f0614854
JB
3461 vinfo_template.screen = XScreenNumberOfScreen (screen);
3462
3463 vinfo = XGetVisualInfo (x_current_display,
3464 VisualIDMask | VisualScreenMask, &vinfo_template,
01f1ba30
JB
3465 &n_visuals);
3466 if (n_visuals != 1)
3467 fatal ("Can't get proper X visual info");
3468
3469 if ((1 << vinfo->depth) == vinfo->colormap_size)
3470 *depth = vinfo->depth;
3471 else
3472 {
3473 int i = 0;
3474 int n = vinfo->colormap_size - 1;
3475 while (n)
3476 {
3477 n = n >> 1;
3478 i++;
3479 }
3480 *depth = i;
3481 }
3482
3483 XFree ((char *) vinfo);
3484 return v;
3485}
3486#endif /* HAVE_X11 */
3487
3488DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
3489 1, 2, 0, "Open a connection to an X server.\n\
d387c960
JB
3490DISPLAY is the name of the display to connect to.\n\
3491Optional second arg XRM_STRING is a string of resources in xrdb format.")
01f1ba30
JB
3492 (display, xrm_string)
3493 Lisp_Object display, xrm_string;
3494{
3495 unsigned int n_planes;
01f1ba30
JB
3496 unsigned char *xrm_option;
3497
3498 CHECK_STRING (display, 0);
3499 if (x_current_display != 0)
3500 error ("X server connection is already initialized");
d387c960
JB
3501 if (! NILP (xrm_string))
3502 CHECK_STRING (xrm_string, 1);
01f1ba30
JB
3503
3504 /* This is what opens the connection and sets x_current_display.
3505 This also initializes many symbols, such as those used for input. */
3506 x_term_init (XSTRING (display)->data);
3507
01f1ba30
JB
3508#ifdef HAVE_X11
3509 XFASTINT (Vwindow_system_version) = 11;
3510
d387c960
JB
3511 if (! NILP (xrm_string))
3512 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
01f1ba30
JB
3513 else
3514 xrm_option = (unsigned char *) 0;
d387c960
JB
3515
3516 validate_x_resource_name ();
3517
a081bd37 3518 BLOCK_INPUT;
d387c960
JB
3519 xrdb = x_load_resources (x_current_display, xrm_option,
3520 (char *) XSTRING (Vx_resource_name)->data,
3521 EMACS_CLASS);
a081bd37 3522 UNBLOCK_INPUT;
d387c960 3523#if defined (HAVE_X11R5)
eb5d618c
JB
3524 XrmSetDatabase (x_current_display, xrdb);
3525#else
01f1ba30 3526 x_current_display->db = xrdb;
eb5d618c 3527#endif
01f1ba30
JB
3528
3529 x_screen = DefaultScreenOfDisplay (x_current_display);
3530
01f1ba30 3531 screen_visual = select_visual (x_screen, &n_planes);
a6605e5c 3532 x_screen_planes = n_planes;
41beb8fc
RS
3533 x_screen_height = HeightOfScreen (x_screen);
3534 x_screen_width = WidthOfScreen (x_screen);
01f1ba30
JB
3535
3536 /* X Atoms used by emacs. */
99e72068 3537 Xatoms_of_xselect ();
01f1ba30 3538 BLOCK_INPUT;
3c254570
JA
3539 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
3540 False);
3541 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
3542 False);
3543 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
3544 False);
3545 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
3546 False);
3547 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
3548 False);
3549 Xatom_wm_configure_denied = XInternAtom (x_current_display,
3550 "WM_CONFIGURE_DENIED", False);
3551 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
3552 False);
01f1ba30
JB
3553 UNBLOCK_INPUT;
3554#else /* not HAVE_X11 */
3555 XFASTINT (Vwindow_system_version) = 10;
3556#endif /* not HAVE_X11 */
3557 return Qnil;
3558}
3559
3560DEFUN ("x-close-current-connection", Fx_close_current_connection,
3561 Sx_close_current_connection,
3562 0, 0, 0, "Close the connection to the current X server.")
3563 ()
3564{
3565#ifdef HAVE_X11
3566 /* This is ONLY used when killing emacs; For switching displays
3567 we'll have to take care of setting CloseDownMode elsewhere. */
3568
3569 if (x_current_display)
3570 {
3571 BLOCK_INPUT;
3572 XSetCloseDownMode (x_current_display, DestroyAll);
3573 XCloseDisplay (x_current_display);
739f2f53 3574 x_current_display = 0;
01f1ba30
JB
3575 }
3576 else
3577 fatal ("No current X display connection to close\n");
3578#endif
3579 return Qnil;
3580}
3581
3582DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
3583 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3584If ON is nil, allow buffering of requests.\n\
3585Turning on synchronization prohibits the Xlib routines from buffering\n\
3586requests and seriously degrades performance, but makes debugging much\n\
3587easier.")
3588 (on)
3589 Lisp_Object on;
3590{
11ae94fe
RS
3591 check_x ();
3592
01f1ba30
JB
3593 XSynchronize (x_current_display, !EQ (on, Qnil));
3594
3595 return Qnil;
3596}
3597
3598\f
3599syms_of_xfns ()
3600{
01f1ba30
JB
3601 /* This is zero if not using X windows. */
3602 x_current_display = 0;
3603
f9942c9e
JB
3604 /* The section below is built by the lisp expression at the top of the file,
3605 just above where these variables are declared. */
3606 /*&&& init symbols here &&&*/
3607 Qauto_raise = intern ("auto-raise");
3608 staticpro (&Qauto_raise);
3609 Qauto_lower = intern ("auto-lower");
3610 staticpro (&Qauto_lower);
3611 Qbackground_color = intern ("background-color");
3612 staticpro (&Qbackground_color);
dbc4e1c1
JB
3613 Qbar = intern ("bar");
3614 staticpro (&Qbar);
f9942c9e
JB
3615 Qborder_color = intern ("border-color");
3616 staticpro (&Qborder_color);
3617 Qborder_width = intern ("border-width");
3618 staticpro (&Qborder_width);
dbc4e1c1
JB
3619 Qbox = intern ("box");
3620 staticpro (&Qbox);
f9942c9e
JB
3621 Qcursor_color = intern ("cursor-color");
3622 staticpro (&Qcursor_color);
dbc4e1c1
JB
3623 Qcursor_type = intern ("cursor-type");
3624 staticpro (&Qcursor_type);
f9942c9e
JB
3625 Qfont = intern ("font");
3626 staticpro (&Qfont);
3627 Qforeground_color = intern ("foreground-color");
3628 staticpro (&Qforeground_color);
3629 Qgeometry = intern ("geometry");
3630 staticpro (&Qgeometry);
f9942c9e
JB
3631 Qicon_left = intern ("icon-left");
3632 staticpro (&Qicon_left);
3633 Qicon_top = intern ("icon-top");
3634 staticpro (&Qicon_top);
3635 Qicon_type = intern ("icon-type");
3636 staticpro (&Qicon_type);
f9942c9e
JB
3637 Qinternal_border_width = intern ("internal-border-width");
3638 staticpro (&Qinternal_border_width);
3639 Qleft = intern ("left");
3640 staticpro (&Qleft);
3641 Qmouse_color = intern ("mouse-color");
3642 staticpro (&Qmouse_color);
baaed68e
JB
3643 Qnone = intern ("none");
3644 staticpro (&Qnone);
f9942c9e
JB
3645 Qparent_id = intern ("parent-id");
3646 staticpro (&Qparent_id);
8af1d7ca
JB
3647 Qsuppress_icon = intern ("suppress-icon");
3648 staticpro (&Qsuppress_icon);
f9942c9e
JB
3649 Qtop = intern ("top");
3650 staticpro (&Qtop);
01f1ba30 3651 Qundefined_color = intern ("undefined-color");
f9942c9e 3652 staticpro (&Qundefined_color);
a3c87d4e
JB
3653 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
3654 staticpro (&Qvertical_scroll_bars);
49795535
JB
3655 Qvisibility = intern ("visibility");
3656 staticpro (&Qvisibility);
f9942c9e
JB
3657 Qwindow_id = intern ("window-id");
3658 staticpro (&Qwindow_id);
3659 Qx_frame_parameter = intern ("x-frame-parameter");
3660 staticpro (&Qx_frame_parameter);
3661 /* This is the end of symbol initialization. */
3662
01f1ba30
JB
3663 Fput (Qundefined_color, Qerror_conditions,
3664 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
3665 Fput (Qundefined_color, Qerror_message,
3666 build_string ("Undefined color"));
3667
f9942c9e
JB
3668 init_x_parm_symbols ();
3669
01f1ba30 3670 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
d387c960 3671 "The buffer offset of the character under the pointer.");
a6605e5c 3672 mouse_buffer_offset = 0;
01f1ba30 3673
01f1ba30 3674 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape,
d387c960 3675 "The shape of the pointer when over text.\n\
af01ef26
RS
3676Changing the value does not affect existing frames\n\
3677unless you set the mouse color.");
01f1ba30
JB
3678 Vx_pointer_shape = Qnil;
3679
d387c960
JB
3680 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
3681 "The name Emacs uses to look up X resources; for internal use only.\n\
3682`x-get-resource' uses this as the first component of the instance name\n\
3683when requesting resource values.\n\
3684Emacs initially sets `x-resource-name' to the name under which Emacs\n\
3685was invoked, or to the value specified with the `-name' or `-rn'\n\
3686switches, if present.");
3687 Vx_resource_name = Qnil;
3688 staticpro (&Vx_resource_name);
ac63d3d6 3689
af01ef26 3690#if 0
01f1ba30
JB
3691 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
3692 "The shape of the pointer when not over text.");
af01ef26 3693#endif
01f1ba30
JB
3694 Vx_nontext_pointer_shape = Qnil;
3695
af01ef26 3696#if 0
01f1ba30 3697 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
06ef7355 3698 "The shape of the pointer when over the mode line.");
af01ef26 3699#endif
01f1ba30
JB
3700 Vx_mode_pointer_shape = Qnil;
3701
01f1ba30
JB
3702 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
3703 "A string indicating the foreground color of the cursor box.");
3704 Vx_cursor_fore_pixel = Qnil;
3705
3706 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
3707 "Non-nil if a mouse button is currently depressed.");
3708 Vmouse_depressed = Qnil;
3709
01f1ba30
JB
3710 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
3711 "t if no X window manager is in use.");
3712
3713#ifdef HAVE_X11
3714 defsubr (&Sx_get_resource);
85ffea93 3715#if 0
01f1ba30
JB
3716 defsubr (&Sx_draw_rectangle);
3717 defsubr (&Sx_erase_rectangle);
3718 defsubr (&Sx_contour_region);
3719 defsubr (&Sx_uncontour_region);
85ffea93 3720#endif
bcc426b4 3721 defsubr (&Sx_display_color_p);
f0614854 3722 defsubr (&Sx_list_fonts);
8af1d7ca 3723 defsubr (&Sx_color_defined_p);
41beb8fc
RS
3724 defsubr (&Sx_server_vendor);
3725 defsubr (&Sx_server_version);
3726 defsubr (&Sx_display_pixel_width);
3727 defsubr (&Sx_display_pixel_height);
3728 defsubr (&Sx_display_mm_width);
3729 defsubr (&Sx_display_mm_height);
3730 defsubr (&Sx_display_screens);
3731 defsubr (&Sx_display_planes);
3732 defsubr (&Sx_display_color_cells);
3733 defsubr (&Sx_display_visual_class);
3734 defsubr (&Sx_display_backing_store);
3735 defsubr (&Sx_display_save_under);
9d04a87a
RS
3736 defsubr (&Sx_rebind_key);
3737 defsubr (&Sx_rebind_keys);
01f1ba30
JB
3738#if 0
3739 defsubr (&Sx_track_pointer);
01f1ba30
JB
3740 defsubr (&Sx_grab_pointer);
3741 defsubr (&Sx_ungrab_pointer);
809ca691 3742#endif
01f1ba30
JB
3743#else
3744 defsubr (&Sx_get_default);
3745 defsubr (&Sx_store_cut_buffer);
3746 defsubr (&Sx_get_cut_buffer);
01f1ba30 3747#endif
8af1d7ca 3748 defsubr (&Sx_parse_geometry);
f676886a
JB
3749 defsubr (&Sx_create_frame);
3750 defsubr (&Sfocus_frame);
3751 defsubr (&Sunfocus_frame);
06ef7355 3752#if 0
01f1ba30 3753 defsubr (&Sx_horizontal_line);
06ef7355 3754#endif
01f1ba30
JB
3755 defsubr (&Sx_open_connection);
3756 defsubr (&Sx_close_current_connection);
3757 defsubr (&Sx_synchronize);
01f1ba30
JB
3758}
3759
3760#endif /* HAVE_X_WINDOWS */