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