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