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