(cross_cursor): New field for struct x_display.
[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;
80eb0a99
FP
1779 int menubar_size =
1780 (f->display.x->menubar_widget
1781 ? (f->display.x->menubar_widget->core.height
1782 + f->display.x->menubar_widget->core.border_width)
1783 : 0);
a7f7d550
FP
1784
1785 if (window_prompting & USPosition)
1786 sprintf (shell_position, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f),
80eb0a99 1787 PIXEL_HEIGHT (f) + menubar_size,
a7f7d550
FP
1788 '+', f->display.x->left_pos,
1789 '+', f->display.x->top_pos);
1790 else
1791 sprintf (shell_position, "=%dx%d", PIXEL_WIDTH (f),
80eb0a99 1792 PIXEL_HEIGHT (f) + menubar_size);
a7f7d550
FP
1793 len = strlen (shell_position) + 1;
1794 tem = (char *) xmalloc (len);
1795 strncpy (tem, shell_position, len);
1796 XtSetArg (al[ac], XtNgeometry, tem); ac++;
1797 XtSetValues (shell_widget, al, ac);
1798 }
1799
1800
9ef48a9d
RS
1801 XtManageChild (pane_widget);
1802 XtRealizeWidget (shell_widget);
1803
1804 FRAME_X_WINDOW (f) = XtWindow (screen_widget);
1805
1806 validate_x_resource_name ();
1807 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
1808 class_hints.res_class = EMACS_CLASS;
1809 XSetClassHint (x_current_display, XtWindow (shell_widget), &class_hints);
1810
1811 hack_wm_protocols (shell_widget);
1812
1813 /* Do a stupid property change to force the server to generate a
1814 propertyNotify event so that the event_stream server timestamp will
1815 be initialized to something relevant to the time we created the window.
1816 */
1817 XChangeProperty (XtDisplay (screen_widget), XtWindow (screen_widget),
1818 Xatom_wm_protocols, XA_ATOM, 32, PropModeAppend,
1819 (unsigned char*) NULL, 0);
1820
31ac8d8c
FP
1821 /* Make all the standard events reach the Emacs frame. */
1822 attributes.event_mask = STANDARD_EVENT_SET;
1823 attribute_mask = CWEventMask;
1824 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
1825 attribute_mask, &attributes);
1826
9ef48a9d
RS
1827 XtMapWidget (screen_widget);
1828
1829#else /* not USE_X_TOOLKIT */
1830
01f1ba30 1831
f676886a
JB
1832 attributes.background_pixel = f->display.x->background_pixel;
1833 attributes.border_pixel = f->display.x->border_pixel;
01f1ba30
JB
1834 attributes.bit_gravity = StaticGravity;
1835 attributes.backing_store = NotUseful;
1836 attributes.save_under = True;
1837 attributes.event_mask = STANDARD_EVENT_SET;
1838 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
1839#if 0
1840 | CWBackingStore | CWSaveUnder
1841#endif
1842 | CWEventMask);
1843
1844 BLOCK_INPUT;
fe24a618 1845 FRAME_X_WINDOW (f)
01f1ba30 1846 = XCreateWindow (x_current_display, ROOT_WINDOW,
f676886a
JB
1847 f->display.x->left_pos,
1848 f->display.x->top_pos,
1849 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
1850 f->display.x->border_width,
01f1ba30
JB
1851 CopyFromParent, /* depth */
1852 InputOutput, /* class */
1853 screen_visual, /* set in Fx_open_connection */
1854 attribute_mask, &attributes);
1855
d387c960
JB
1856 validate_x_resource_name ();
1857 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
01f1ba30 1858 class_hints.res_class = EMACS_CLASS;
fe24a618 1859 XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
01f1ba30 1860
179956b9
JB
1861 /* This indicates that we use the "Passive Input" input model.
1862 Unless we do this, we don't get the Focus{In,Out} events that we
1863 need to draw the cursor correctly. Accursed bureaucrats.
1864 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1865
1866 f->display.x->wm_hints.input = True;
1867 f->display.x->wm_hints.flags |= InputHint;
1868 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
dcce9abd
RS
1869 XSetWMProtocols (x_current_display, FRAME_X_WINDOW (f),
1870 &Xatom_wm_delete_window, 1);
179956b9 1871
9ef48a9d
RS
1872#endif /* not USE_X_TOOLKIT */
1873
e373f201
JB
1874 /* x_set_name normally ignores requests to set the name if the
1875 requested name is the same as the current name. This is the one
1876 place where that assumption isn't correct; f->name is set, but
1877 the X server hasn't been told. */
1878 {
98381190 1879 Lisp_Object name;
cf177271 1880 int explicit = f->explicit_name;
e373f201 1881
cf177271 1882 f->explicit_name = 0;
98381190
KH
1883 name = f->name;
1884 f->name = Qnil;
cf177271 1885 x_set_name (f, name, explicit);
e373f201
JB
1886 }
1887
fe24a618 1888 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
f676886a 1889 f->display.x->text_cursor);
9ef48a9d 1890
01f1ba30
JB
1891 UNBLOCK_INPUT;
1892
fe24a618 1893 if (FRAME_X_WINDOW (f) == 0)
9ef48a9d 1894 error ("Unable to create window");
01f1ba30
JB
1895}
1896
1897/* Handle the icon stuff for this window. Perhaps later we might
1898 want an x_set_icon_position which can be called interactively as
1899 well. */
1900
1901static void
f676886a
JB
1902x_icon (f, parms)
1903 struct frame *f;
01f1ba30
JB
1904 Lisp_Object parms;
1905{
f9942c9e 1906 Lisp_Object icon_x, icon_y;
01f1ba30
JB
1907
1908 /* Set the position of the icon. Note that twm groups all
1909 icons in an icon window. */
cf177271
JB
1910 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
1911 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
f9942c9e 1912 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
01f1ba30 1913 {
f9942c9e
JB
1914 CHECK_NUMBER (icon_x, 0);
1915 CHECK_NUMBER (icon_y, 0);
01f1ba30 1916 }
f9942c9e 1917 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
01f1ba30 1918 error ("Both left and top icon corners of icon must be specified");
01f1ba30 1919
f9942c9e
JB
1920 BLOCK_INPUT;
1921
fe24a618
JB
1922 if (! EQ (icon_x, Qunbound))
1923 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
f9942c9e 1924
01f1ba30 1925 /* Start up iconic or window? */
49795535
JB
1926 x_wm_set_window_state
1927 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
1928 ? IconicState
1929 : NormalState));
01f1ba30 1930
01f1ba30
JB
1931 UNBLOCK_INPUT;
1932}
1933
1934/* Make the GC's needed for this window, setting the
1935 background, border and mouse colors; also create the
1936 mouse cursor and the gray border tile. */
1937
f945b920
JB
1938static char cursor_bits[] =
1939 {
1940 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1941 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1942 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1943 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1944 };
1945
01f1ba30 1946static void
f676886a
JB
1947x_make_gc (f)
1948 struct frame *f;
01f1ba30
JB
1949{
1950 XGCValues gc_values;
1951 GC temp_gc;
1952 XImage tileimage;
01f1ba30 1953
6afb1d07
JB
1954 BLOCK_INPUT;
1955
f676886a 1956 /* Create the GC's of this frame.
9ef48a9d 1957 Note that many default values are used. */
01f1ba30
JB
1958
1959 /* Normal video */
f676886a
JB
1960 gc_values.font = f->display.x->font->fid;
1961 gc_values.foreground = f->display.x->foreground_pixel;
1962 gc_values.background = f->display.x->background_pixel;
9ef48a9d 1963 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
f676886a 1964 f->display.x->normal_gc = XCreateGC (x_current_display,
fe24a618 1965 FRAME_X_WINDOW (f),
01f1ba30
JB
1966 GCLineWidth | GCFont
1967 | GCForeground | GCBackground,
1968 &gc_values);
1969
1970 /* Reverse video style. */
f676886a
JB
1971 gc_values.foreground = f->display.x->background_pixel;
1972 gc_values.background = f->display.x->foreground_pixel;
1973 f->display.x->reverse_gc = XCreateGC (x_current_display,
fe24a618 1974 FRAME_X_WINDOW (f),
01f1ba30
JB
1975 GCFont | GCForeground | GCBackground
1976 | GCLineWidth,
1977 &gc_values);
1978
9ef48a9d 1979 /* Cursor has cursor-color background, background-color foreground. */
f676886a
JB
1980 gc_values.foreground = f->display.x->background_pixel;
1981 gc_values.background = f->display.x->cursor_pixel;
01f1ba30
JB
1982 gc_values.fill_style = FillOpaqueStippled;
1983 gc_values.stipple
1984 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1985 cursor_bits, 16, 16);
f676886a 1986 f->display.x->cursor_gc
fe24a618 1987 = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
1988 (GCFont | GCForeground | GCBackground
1989 | GCFillStyle | GCStipple | GCLineWidth),
1990 &gc_values);
1991
1992 /* Create the gray border tile used when the pointer is not in
f676886a 1993 the frame. Since this depends on the frame's pixel values,
9ef48a9d 1994 this must be done on a per-frame basis. */
d043f1a4
RS
1995 f->display.x->border_tile
1996 = (XCreatePixmapFromBitmapData
1997 (x_current_display, ROOT_WINDOW,
1998 gray_bits, gray_width, gray_height,
1999 f->display.x->foreground_pixel,
2000 f->display.x->background_pixel,
2001 DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
6afb1d07
JB
2002
2003 UNBLOCK_INPUT;
01f1ba30
JB
2004}
2005#endif /* HAVE_X11 */
2006
f676886a 2007DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
01f1ba30 2008 1, 1, 0,
f676886a
JB
2009 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2010Return an Emacs frame object representing the X window.\n\
2011ALIST is an alist of frame parameters.\n\
2012If the parameters specify that the frame should not have a minibuffer,\n\
e22d6b02 2013and do not specify a specific minibuffer window to use,\n\
f676886a
JB
2014then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2015be shared by the new frame.")
01f1ba30
JB
2016 (parms)
2017 Lisp_Object parms;
2018{
2019#ifdef HAVE_X11
f676886a 2020 struct frame *f;
8014cc03 2021 Lisp_Object frame, tem, tem0, tem1;
01f1ba30
JB
2022 Lisp_Object name;
2023 int minibuffer_only = 0;
2024 long window_prompting = 0;
2025 int width, height;
9ef48a9d 2026 int count = specpdl_ptr - specpdl;
01f1ba30 2027
11ae94fe 2028 check_x ();
01f1ba30 2029
cf177271
JB
2030 name = x_get_arg (parms, Qname, "title", "Title", string);
2031 if (XTYPE (name) != Lisp_String
2032 && ! EQ (name, Qunbound)
2033 && ! NILP (name))
f676886a 2034 error ("x-create-frame: name parameter must be a string");
01f1ba30 2035
cf177271 2036 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
f9942c9e 2037 if (EQ (tem, Qnone) || NILP (tem))
f676886a 2038 f = make_frame_without_minibuffer (Qnil);
f9942c9e 2039 else if (EQ (tem, Qonly))
01f1ba30 2040 {
f676886a 2041 f = make_minibuffer_frame ();
01f1ba30
JB
2042 minibuffer_only = 1;
2043 }
f9942c9e 2044 else if (XTYPE (tem) == Lisp_Window)
f676886a 2045 f = make_frame_without_minibuffer (tem);
f9942c9e
JB
2046 else
2047 f = make_frame (1);
01f1ba30 2048
a3c87d4e
JB
2049 /* Note that X Windows does support scroll bars. */
2050 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
179956b9 2051
cf177271
JB
2052 /* Set the name; the functions to which we pass f expect the name to
2053 be set. */
2054 if (EQ (name, Qunbound) || NILP (name))
2055 {
2056 f->name = build_string (x_id_name);
2057 f->explicit_name = 0;
2058 }
2059 else
2060 {
2061 f->name = name;
2062 f->explicit_name = 1;
9ef48a9d
RS
2063 /* use the frame's title when getting resources for this frame. */
2064 specbind (Qx_resource_name, name);
cf177271 2065 }
01f1ba30 2066
f676886a
JB
2067 XSET (frame, Lisp_Frame, f);
2068 f->output_method = output_x_window;
2069 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
2070 bzero (f->display.x, sizeof (struct x_display));
01f1ba30 2071
f676886a
JB
2072 /* Note that the frame has no physical cursor right now. */
2073 f->phys_cursor_x = -1;
265a9e55 2074
01f1ba30
JB
2075 /* Extract the window parameters from the supplied values
2076 that are needed to determine window geometry. */
d387c960
JB
2077 {
2078 Lisp_Object font;
2079
e5e548e3 2080 font = x_get_arg (parms, Qfont, "font", "Font", string);
6817eab4 2081 BLOCK_INPUT;
e5e548e3
RS
2082 /* First, try whatever font the caller has specified. */
2083 if (STRINGP (font))
e5229110 2084 font = x_new_font (f, XSTRING (font)->data);
e5e548e3
RS
2085 /* Try out a font which we hope has bold and italic variations. */
2086 if (!STRINGP (font))
2087 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2088 if (! STRINGP (font))
2089 font = x_new_font (f, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2090 if (! STRINGP (font))
2091 /* This was formerly the first thing tried, but it finds too many fonts
2092 and takes too long. */
2093 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2094 /* If those didn't work, look for something which will at least work. */
2095 if (! STRINGP (font))
2096 font = x_new_font (f, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
6817eab4
JB
2097 UNBLOCK_INPUT;
2098 if (! STRINGP (font))
e5e548e3
RS
2099 font = build_string ("fixed");
2100
d387c960
JB
2101 x_default_parameter (f, parms, Qfont, font,
2102 "font", "Font", string);
2103 }
9ef48a9d 2104
cf177271
JB
2105 x_default_parameter (f, parms, Qborder_width, make_number (2),
2106 "borderwidth", "BorderWidth", number);
ddf768c3
JB
2107 /* This defaults to 2 in order to match xterm. We recognize either
2108 internalBorderWidth or internalBorder (which is what xterm calls
2109 it). */
2110 if (NILP (Fassq (Qinternal_border_width, parms)))
2111 {
2112 Lisp_Object value;
2113
2114 value = x_get_arg (parms, Qinternal_border_width,
2115 "internalBorder", "BorderWidth", number);
2116 if (! EQ (value, Qunbound))
2117 parms = Fcons (Fcons (Qinternal_border_width, value),
2118 parms);
2119 }
cf177271
JB
2120 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
2121 "internalBorderWidth", "BorderWidth", number);
a3c87d4e
JB
2122 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
2123 "verticalScrollBars", "ScrollBars", boolean);
01f1ba30
JB
2124
2125 /* Also do the stuff which must be set before the window exists. */
cf177271
JB
2126 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
2127 "foreground", "Foreground", string);
2128 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
2129 "background", "Background", string);
2130 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
2131 "pointerColor", "Foreground", string);
2132 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
2133 "cursorColor", "Foreground", string);
2134 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
2135 "borderColor", "BorderColor", string);
01f1ba30 2136
f676886a
JB
2137 f->display.x->parent_desc = ROOT_WINDOW;
2138 window_prompting = x_figure_window_size (f, parms);
01f1ba30 2139
a7f7d550
FP
2140#ifdef USE_X_TOOLKIT
2141 x_window (f, window_prompting, minibuffer_only);
2142#else
f676886a 2143 x_window (f);
a7f7d550 2144#endif
f676886a
JB
2145 x_icon (f, parms);
2146 x_make_gc (f);
ea96210c 2147 init_frame_faces (f);
01f1ba30 2148
f9942c9e
JB
2149 /* We need to do this after creating the X window, so that the
2150 icon-creation functions can say whose icon they're describing. */
cf177271 2151 x_default_parameter (f, parms, Qicon_type, Qnil,
6998a3b4 2152 "bitmapIcon", "BitmapIcon", symbol);
f9942c9e 2153
cf177271
JB
2154 x_default_parameter (f, parms, Qauto_raise, Qnil,
2155 "autoRaise", "AutoRaiseLower", boolean);
2156 x_default_parameter (f, parms, Qauto_lower, Qnil,
2157 "autoLower", "AutoRaiseLower", boolean);
dbc4e1c1
JB
2158 x_default_parameter (f, parms, Qcursor_type, Qbox,
2159 "cursorType", "CursorType", symbol);
f9942c9e 2160
f676886a 2161 /* Dimensions, especially f->height, must be done via change_frame_size.
01f1ba30 2162 Change will not be effected unless different from the current
f676886a
JB
2163 f->height. */
2164 width = f->width;
2165 height = f->height;
2166 f->height = f->width = 0;
f9942c9e 2167 change_frame_size (f, height, width, 1, 0);
d043f1a4
RS
2168
2169 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0),
2170 "menuBarLines", "MenuBarLines", number);
2171
a7f7d550
FP
2172/* With the toolkit, the geometry management is done in x_window. */
2173#ifndef USE_X_TOOLKIT
f58534a3
RS
2174 tem0 = x_get_arg (parms, Qleft, 0, 0, number);
2175 tem1 = x_get_arg (parms, Qtop, 0, 0, number);
01f1ba30 2176 BLOCK_INPUT;
363f7e15 2177 x_wm_set_size_hint (f, window_prompting, 1, XINT (tem0), XINT (tem1));
01f1ba30 2178 UNBLOCK_INPUT;
a7f7d550 2179#endif /* USE_X_TOOLKIT */
01f1ba30 2180
cf177271 2181 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
f676886a 2182 f->no_split = minibuffer_only || EQ (tem, Qt);
01f1ba30 2183
59d61058
RS
2184 /* It is now ok to make the frame official
2185 even if we get an error below.
2186 And the frame needs to be on Vframe_list
2187 or making it visible won't work. */
2188 Vframe_list = Fcons (frame, Vframe_list);
2189
d043f1a4
RS
2190 /* Make the window appear on the frame and enable display,
2191 unless the caller says not to. */
49795535 2192 {
98381190 2193 Lisp_Object visibility;
49795535 2194
98381190 2195 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
49795535
JB
2196 if (EQ (visibility, Qunbound))
2197 visibility = Qt;
2198
2199 if (EQ (visibility, Qicon))
2200 x_iconify_frame (f);
2201 else if (! NILP (visibility))
2202 x_make_frame_visible (f);
2203 else
2204 /* Must have been Qnil. */
2205 ;
2206 }
01f1ba30 2207
9ef48a9d 2208 return unbind_to (count, frame);
01f1ba30 2209#else /* X10 */
f676886a
JB
2210 struct frame *f;
2211 Lisp_Object frame, tem;
01f1ba30
JB
2212 Lisp_Object name;
2213 int pixelwidth, pixelheight;
2214 Cursor cursor;
2215 int height, width;
2216 Window parent;
2217 Pixmap temp;
2218 int minibuffer_only = 0;
2219 Lisp_Object vscroll, hscroll;
2220
2221 if (x_current_display == 0)
2222 error ("X windows are not in use or not initialized");
2223
f9942c9e 2224 name = Fassq (Qname, parms);
01f1ba30 2225
cf177271 2226 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
f9942c9e 2227 if (EQ (tem, Qnone))
f676886a 2228 f = make_frame_without_minibuffer (Qnil);
f9942c9e 2229 else if (EQ (tem, Qonly))
01f1ba30 2230 {
f676886a 2231 f = make_minibuffer_frame ();
01f1ba30
JB
2232 minibuffer_only = 1;
2233 }
f9942c9e 2234 else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
f676886a 2235 f = make_frame (1);
f9942c9e
JB
2236 else
2237 f = make_frame_without_minibuffer (tem);
01f1ba30
JB
2238
2239 parent = ROOT_WINDOW;
2240
f676886a
JB
2241 XSET (frame, Lisp_Frame, f);
2242 f->output_method = output_x_window;
2243 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
2244 bzero (f->display.x, sizeof (struct x_display));
01f1ba30 2245
eb8c3be9 2246 /* Some temporary default values for height and width. */
01f1ba30
JB
2247 width = 80;
2248 height = 40;
f676886a
JB
2249 f->display.x->left_pos = -1;
2250 f->display.x->top_pos = -1;
01f1ba30 2251
f676886a 2252 /* Give the frame a default name (which may be overridden with PARMS). */
01f1ba30
JB
2253
2254 strncpy (iconidentity, ICONTAG, MAXICID);
2255 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
2256 (MAXICID - 1) - sizeof (ICONTAG)))
2257 iconidentity[sizeof (ICONTAG) - 2] = '\0';
f676886a 2258 f->name = build_string (iconidentity);
01f1ba30
JB
2259
2260 /* Extract some window parameters from the supplied values.
2261 These are the parameters that affect window geometry. */
2262
cf177271 2263 tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
f9942c9e 2264 if (EQ (tem, Qunbound))
01f1ba30 2265 tem = build_string ("9x15");
f9942c9e
JB
2266 x_set_font (f, tem, Qnil);
2267 x_default_parameter (f, parms, Qborder_color,
cf177271 2268 build_string ("black"), "Border", 0, string);
f9942c9e 2269 x_default_parameter (f, parms, Qbackground_color,
cf177271 2270 build_string ("white"), "Background", 0, string);
f9942c9e 2271 x_default_parameter (f, parms, Qforeground_color,
cf177271 2272 build_string ("black"), "Foreground", 0, string);
f9942c9e 2273 x_default_parameter (f, parms, Qmouse_color,
cf177271 2274 build_string ("black"), "Mouse", 0, string);
f9942c9e 2275 x_default_parameter (f, parms, Qcursor_color,
cf177271 2276 build_string ("black"), "Cursor", 0, string);
f9942c9e 2277 x_default_parameter (f, parms, Qborder_width,
cf177271 2278 make_number (2), "BorderWidth", 0, number);
f9942c9e 2279 x_default_parameter (f, parms, Qinternal_border_width,
cf177271 2280 make_number (4), "InternalBorderWidth", 0, number);
f9942c9e 2281 x_default_parameter (f, parms, Qauto_raise,
cf177271 2282 Qnil, "AutoRaise", 0, boolean);
01f1ba30 2283
cf177271
JB
2284 hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
2285 vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
01f1ba30 2286
f676886a
JB
2287 if (f->display.x->internal_border_width < 0)
2288 f->display.x->internal_border_width = 0;
01f1ba30 2289
cf177271 2290 tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
f9942c9e 2291 if (!EQ (tem, Qunbound))
01f1ba30
JB
2292 {
2293 WINDOWINFO_TYPE wininfo;
2294 int nchildren;
2295 Window *children, root;
2296
f9942c9e 2297 CHECK_NUMBER (tem, 0);
fe24a618 2298 FRAME_X_WINDOW (f) = (Window) XINT (tem);
01f1ba30
JB
2299
2300 BLOCK_INPUT;
fe24a618
JB
2301 XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
2302 XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
9ac0d9e0 2303 xfree (children);
01f1ba30
JB
2304 UNBLOCK_INPUT;
2305
cf177271
JB
2306 height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
2307 width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
f676886a
JB
2308 f->display.x->left_pos = wininfo.x;
2309 f->display.x->top_pos = wininfo.y;
179956b9 2310 FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
f676886a
JB
2311 f->display.x->border_width = wininfo.bdrwidth;
2312 f->display.x->parent_desc = parent;
01f1ba30
JB
2313 }
2314 else
2315 {
cf177271 2316 tem = x_get_arg (parms, Qparent_id, 0, 0, number);
f9942c9e 2317 if (!EQ (tem, Qunbound))
01f1ba30 2318 {
f9942c9e
JB
2319 CHECK_NUMBER (tem, 0);
2320 parent = (Window) XINT (tem);
01f1ba30 2321 }
f676886a 2322 f->display.x->parent_desc = parent;
cf177271 2323 tem = x_get_arg (parms, Qheight, 0, 0, number);
f9942c9e 2324 if (EQ (tem, Qunbound))
01f1ba30 2325 {
cf177271 2326 tem = x_get_arg (parms, Qwidth, 0, 0, number);
f9942c9e 2327 if (EQ (tem, Qunbound))
01f1ba30 2328 {
cf177271 2329 tem = x_get_arg (parms, Qtop, 0, 0, number);
f9942c9e 2330 if (EQ (tem, Qunbound))
cf177271 2331 tem = x_get_arg (parms, Qleft, 0, 0, number);
01f1ba30
JB
2332 }
2333 }
f9942c9e 2334 /* Now TEM is Qunbound if no edge or size was specified.
01f1ba30 2335 In that case, we must do rubber-banding. */
f9942c9e 2336 if (EQ (tem, Qunbound))
01f1ba30 2337 {
cf177271 2338 tem = x_get_arg (parms, Qgeometry, 0, 0, number);
f676886a
JB
2339 x_rubber_band (f,
2340 &f->display.x->left_pos, &f->display.x->top_pos,
01f1ba30
JB
2341 &width, &height,
2342 (XTYPE (tem) == Lisp_String
2343 ? (char *) XSTRING (tem)->data : ""),
f676886a 2344 XSTRING (f->name)->data,
265a9e55 2345 !NILP (hscroll), !NILP (vscroll));
01f1ba30
JB
2346 }
2347 else
2348 {
2349 /* Here if at least one edge or size was specified.
2350 Demand that they all were specified, and use them. */
cf177271 2351 tem = x_get_arg (parms, Qheight, 0, 0, number);
f9942c9e 2352 if (EQ (tem, Qunbound))
01f1ba30
JB
2353 error ("Height not specified");
2354 CHECK_NUMBER (tem, 0);
2355 height = XINT (tem);
2356
cf177271 2357 tem = x_get_arg (parms, Qwidth, 0, 0, number);
f9942c9e 2358 if (EQ (tem, Qunbound))
01f1ba30
JB
2359 error ("Width not specified");
2360 CHECK_NUMBER (tem, 0);
2361 width = XINT (tem);
2362
cf177271 2363 tem = x_get_arg (parms, Qtop, 0, 0, number);
f9942c9e 2364 if (EQ (tem, Qunbound))
01f1ba30
JB
2365 error ("Top position not specified");
2366 CHECK_NUMBER (tem, 0);
f676886a 2367 f->display.x->left_pos = XINT (tem);
01f1ba30 2368
cf177271 2369 tem = x_get_arg (parms, Qleft, 0, 0, number);
f9942c9e 2370 if (EQ (tem, Qunbound))
01f1ba30
JB
2371 error ("Left position not specified");
2372 CHECK_NUMBER (tem, 0);
f676886a 2373 f->display.x->top_pos = XINT (tem);
01f1ba30
JB
2374 }
2375
cf177271
JB
2376 pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
2377 pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
01f1ba30
JB
2378
2379 BLOCK_INPUT;
fe24a618 2380 FRAME_X_WINDOW (f)
01f1ba30 2381 = XCreateWindow (parent,
f676886a
JB
2382 f->display.x->left_pos, /* Absolute horizontal offset */
2383 f->display.x->top_pos, /* Absolute Vertical offset */
01f1ba30 2384 pixelwidth, pixelheight,
f676886a 2385 f->display.x->border_width,
01f1ba30
JB
2386 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
2387 UNBLOCK_INPUT;
fe24a618 2388 if (FRAME_X_WINDOW (f) == 0)
01f1ba30
JB
2389 error ("Unable to create window.");
2390 }
2391
2392 /* Install the now determined height and width
2393 in the windows and in phys_lines and desired_lines. */
f9942c9e 2394 change_frame_size (f, height, width, 1, 0);
fe24a618 2395 XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
01f1ba30
JB
2396 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2397 | EnterWindow | LeaveWindow | UnmapWindow );
f676886a 2398 x_set_resize_hint (f);
01f1ba30
JB
2399
2400 /* Tell the server the window's default name. */
fe24a618 2401 XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
1113d9db 2402
01f1ba30
JB
2403 /* Now override the defaults with all the rest of the specified
2404 parms. */
cf177271 2405 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
f676886a 2406 f->no_split = minibuffer_only || EQ (tem, Qt);
01f1ba30 2407
8af1d7ca
JB
2408 /* Do not create an icon window if the caller says not to */
2409 if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
2410 || f->display.x->parent_desc != ROOT_WINDOW)
2411 {
2412 x_text_icon (f, iconidentity);
2413 x_default_parameter (f, parms, Qicon_type, Qnil,
2414 "BitmapIcon", 0, symbol);
2415 }
01f1ba30
JB
2416
2417 /* Tell the X server the previously set values of the
2418 background, border and mouse colors; also create the mouse cursor. */
2419 BLOCK_INPUT;
f676886a 2420 temp = XMakeTile (f->display.x->background_pixel);
fe24a618 2421 XChangeBackground (FRAME_X_WINDOW (f), temp);
01f1ba30
JB
2422 XFreePixmap (temp);
2423 UNBLOCK_INPUT;
f676886a 2424 x_set_border_pixel (f, f->display.x->border_pixel);
01f1ba30 2425
f676886a 2426 x_set_mouse_color (f, Qnil, Qnil);
01f1ba30
JB
2427
2428 /* Now override the defaults with all the rest of the specified parms. */
2429
f676886a 2430 Fmodify_frame_parameters (frame, parms);
01f1ba30 2431
f676886a 2432 /* Make the window appear on the frame and enable display. */
49795535 2433 {
98381190 2434 Lisp_Object visibility;
49795535 2435
98381190 2436 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
49795535
JB
2437 if (EQ (visibility, Qunbound))
2438 visibility = Qt;
2439
2440 if (! EQ (visibility, Qicon)
2441 && ! NILP (visibility))
2442 x_make_window_visible (f);
2443 }
01f1ba30 2444
cf177271 2445 SET_FRAME_GARBAGED (f);
01f1ba30 2446
f58534a3 2447 Vframe_list = Fcons (frame, Vframe_list);
f676886a 2448 return frame;
01f1ba30
JB
2449#endif /* X10 */
2450}
2451
87498171
KH
2452Lisp_Object
2453x_get_focus_frame ()
2454{
2455 Lisp_Object xfocus;
2456 if (! x_focus_frame)
2457 return Qnil;
2458
2459 XSET (xfocus, Lisp_Frame, x_focus_frame);
2460 return xfocus;
2461}
2462
f676886a
JB
2463DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2464 "Set the focus on FRAME.")
2465 (frame)
2466 Lisp_Object frame;
01f1ba30 2467{
f676886a 2468 CHECK_LIVE_FRAME (frame, 0);
01f1ba30 2469
f9942c9e 2470 if (FRAME_X_P (XFRAME (frame)))
01f1ba30
JB
2471 {
2472 BLOCK_INPUT;
f676886a 2473 x_focus_on_frame (XFRAME (frame));
01f1ba30 2474 UNBLOCK_INPUT;
f676886a 2475 return frame;
01f1ba30
JB
2476 }
2477
2478 return Qnil;
2479}
2480
f676886a
JB
2481DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2482 "If a frame has been focused, release it.")
01f1ba30
JB
2483 ()
2484{
f676886a 2485 if (x_focus_frame)
01f1ba30
JB
2486 {
2487 BLOCK_INPUT;
f676886a 2488 x_unfocus_frame (x_focus_frame);
01f1ba30
JB
2489 UNBLOCK_INPUT;
2490 }
2491
2492 return Qnil;
2493}
2494\f
2495#ifndef HAVE_X11
2496/* Computes an X-window size and position either from geometry GEO
2497 or with the mouse.
2498
f676886a 2499 F is a frame. It specifies an X window which is used to
01f1ba30
JB
2500 determine which display to compute for. Its font, borders
2501 and colors control how the rectangle will be displayed.
2502
2503 X and Y are where to store the positions chosen.
2504 WIDTH and HEIGHT are where to store the sizes chosen.
2505
2506 GEO is the geometry that may specify some of the info.
2507 STR is a prompt to display.
2508 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2509
2510int
f676886a
JB
2511x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
2512 struct frame *f;
01f1ba30
JB
2513 int *x, *y, *width, *height;
2514 char *geo;
2515 char *str;
2516 int hscroll, vscroll;
2517{
2518 OpaqueFrame frame;
2519 Window tempwindow;
2520 WindowInfo wininfo;
2521 int border_color;
2522 int background_color;
2523 Lisp_Object tem;
2524 int mask;
2525
2526 BLOCK_INPUT;
2527
f676886a
JB
2528 background_color = f->display.x->background_pixel;
2529 border_color = f->display.x->border_pixel;
01f1ba30 2530
f676886a 2531 frame.bdrwidth = f->display.x->border_width;
01f1ba30
JB
2532 frame.border = XMakeTile (border_color);
2533 frame.background = XMakeTile (background_color);
2534 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
f676886a 2535 (2 * f->display.x->internal_border_width
01f1ba30 2536 + (vscroll ? VSCROLL_WIDTH : 0)),
f676886a 2537 (2 * f->display.x->internal_border_width
01f1ba30 2538 + (hscroll ? HSCROLL_HEIGHT : 0)),
f676886a
JB
2539 width, height, f->display.x->font,
2540 FONT_WIDTH (f->display.x->font),
2541 FONT_HEIGHT (f->display.x->font));
01f1ba30
JB
2542 XFreePixmap (frame.border);
2543 XFreePixmap (frame.background);
2544
2545 if (tempwindow != 0)
2546 {
2547 XQueryWindow (tempwindow, &wininfo);
2548 XDestroyWindow (tempwindow);
2549 *x = wininfo.x;
2550 *y = wininfo.y;
2551 }
2552
2553 /* Coordinates we got are relative to the root window.
2554 Convert them to coordinates relative to desired parent window
2555 by scanning from there up to the root. */
f676886a 2556 tempwindow = f->display.x->parent_desc;
01f1ba30
JB
2557 while (tempwindow != ROOT_WINDOW)
2558 {
2559 int nchildren;
2560 Window *children;
2561 XQueryWindow (tempwindow, &wininfo);
2562 *x -= wininfo.x;
2563 *y -= wininfo.y;
2564 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
9ac0d9e0 2565 xfree (children);
01f1ba30
JB
2566 }
2567
2568 UNBLOCK_INPUT;
2569 return tempwindow != 0;
2570}
2571#endif /* not HAVE_X11 */
2572\f
f0614854
JB
2573DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
2574 "Return a list of the names of available fonts matching PATTERN.\n\
2575If optional arguments FACE and FRAME are specified, return only fonts\n\
2576the same size as FACE on FRAME.\n\
2577\n\
2578PATTERN is a string, perhaps with wildcard characters;\n\
2579 the * character matches any substring, and\n\
2580 the ? character matches any single character.\n\
2581 PATTERN is case-insensitive.\n\
2582FACE is a face name - a symbol.\n\
2583\n\
2584The return value is a list of strings, suitable as arguments to\n\
2585set-face-font.\n\
2586\n\
2587The list does not include fonts Emacs can't use (i.e. proportional\n\
2588fonts), even if they match PATTERN and FACE.")
2589 (pattern, face, frame)
2590 Lisp_Object pattern, face, frame;
2591{
2592 int num_fonts;
2593 char **names;
2594 XFontStruct *info;
2595 XFontStruct *size_ref;
2596 Lisp_Object list;
2597
7fc9de26 2598 check_x ();
f0614854
JB
2599 CHECK_STRING (pattern, 0);
2600 if (!NILP (face))
2601 CHECK_SYMBOL (face, 1);
2602 if (!NILP (frame))
739f2f53 2603 CHECK_LIVE_FRAME (frame, 2);
f0614854
JB
2604
2605 if (NILP (face))
2606 size_ref = 0;
2607 else
2608 {
2609 FRAME_PTR f = NILP (frame) ? selected_frame : XFRAME (frame);
2610 int face_id = face_name_id_number (f, face);
2611
a081bd37
JB
2612 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
2613 || FRAME_PARAM_FACES (f) [face_id] == 0)
ea96210c 2614 size_ref = f->display.x->font;
6998a3b4
RS
2615 else
2616 {
a081bd37 2617 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
6998a3b4
RS
2618 if (size_ref == (XFontStruct *) (~0))
2619 size_ref = f->display.x->font;
2620 }
f0614854
JB
2621 }
2622
2623 BLOCK_INPUT;
f58534a3
RS
2624
2625 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2626#ifdef BROKEN_XLISTFONTSWITHINFO
2627 names = XListFonts (x_current_display,
2628 XSTRING (pattern)->data,
2629 2000, /* maxnames */
2630 &num_fonts); /* count_return */
2631#else
f0614854
JB
2632 names = XListFontsWithInfo (x_current_display,
2633 XSTRING (pattern)->data,
ea96210c 2634 2000, /* maxnames */
f0614854
JB
2635 &num_fonts, /* count_return */
2636 &info); /* info_return */
f58534a3 2637#endif
f0614854
JB
2638 UNBLOCK_INPUT;
2639
a9107360 2640 list = Qnil;
f0614854 2641
a9107360
RS
2642 if (names)
2643 {
2644 Lisp_Object *tail;
2645 int i;
2646
59d61058 2647 tail = &list;
a9107360 2648 for (i = 0; i < num_fonts; i++)
f58534a3 2649 {
74712156
KH
2650 XFontStruct *thisinfo;
2651
f58534a3
RS
2652#ifdef BROKEN_XLISTFONTSWITHINFO
2653 BLOCK_INPUT;
74712156 2654 thisinfo = XLoadQueryFont (x_current_display, names[i]);
f58534a3
RS
2655 UNBLOCK_INPUT;
2656#else
74712156 2657 thisinfo = &info[i];
f58534a3 2658#endif
74712156
KH
2659 if (thisinfo && (! size_ref
2660 || same_size_fonts (thisinfo, size_ref)))
f58534a3
RS
2661 {
2662 *tail = Fcons (build_string (names[i]), Qnil);
2663 tail = &XCONS (*tail)->cdr;
2664 }
2665 }
a9107360 2666
f58534a3
RS
2667 BLOCK_INPUT;
2668#ifdef BROKEN_XLISTFONTSWITHINFO
2669 XFreeFontNames (names);
2670#else
a9107360 2671 XFreeFontInfo (names, info, num_fonts);
f58534a3
RS
2672#endif
2673 UNBLOCK_INPUT;
a9107360 2674 }
f0614854
JB
2675
2676 return list;
2677}
2678
2679\f
8af1d7ca 2680DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0,
01f1ba30
JB
2681 "Return t if the current X display supports the color named COLOR.")
2682 (color)
2683 Lisp_Object color;
2684{
2685 Color foo;
2686
11ae94fe 2687 check_x ();
01f1ba30
JB
2688 CHECK_STRING (color, 0);
2689
2690 if (defined_color (XSTRING (color)->data, &foo))
2691 return Qt;
2692 else
2693 return Qnil;
2694}
2695
bcc426b4
RS
2696DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0,
2697 "Return t if the X screen currently in use supports color.")
01f1ba30
JB
2698 ()
2699{
11ae94fe
RS
2700 check_x ();
2701
a6605e5c 2702 if (x_screen_planes <= 2)
01f1ba30
JB
2703 return Qnil;
2704
2705 switch (screen_visual->class)
2706 {
2707 case StaticColor:
2708 case PseudoColor:
2709 case TrueColor:
2710 case DirectColor:
2711 return Qt;
2712
2713 default:
2714 return Qnil;
2715 }
2716}
2717
41beb8fc
RS
2718DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2719 0, 1, 0,
2720 "Returns the width in pixels of the display FRAME is on.")
2721 (frame)
2722 Lisp_Object frame;
2723{
2724 Display *dpy = x_current_display;
11ae94fe 2725 check_x ();
41beb8fc
RS
2726 return make_number (DisplayWidth (dpy, DefaultScreen (dpy)));
2727}
2728
2729DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2730 Sx_display_pixel_height, 0, 1, 0,
2731 "Returns the height in pixels of the display FRAME is on.")
2732 (frame)
2733 Lisp_Object frame;
2734{
2735 Display *dpy = x_current_display;
11ae94fe 2736 check_x ();
41beb8fc
RS
2737 return make_number (DisplayHeight (dpy, DefaultScreen (dpy)));
2738}
2739
2740DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2741 0, 1, 0,
2742 "Returns the number of bitplanes of the display FRAME is on.")
2743 (frame)
2744 Lisp_Object frame;
2745{
2746 Display *dpy = x_current_display;
11ae94fe 2747 check_x ();
41beb8fc
RS
2748 return make_number (DisplayPlanes (dpy, DefaultScreen (dpy)));
2749}
2750
2751DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2752 0, 1, 0,
2753 "Returns the number of color cells of the display FRAME is on.")
2754 (frame)
2755 Lisp_Object frame;
2756{
2757 Display *dpy = x_current_display;
11ae94fe 2758 check_x ();
41beb8fc
RS
2759 return make_number (DisplayCells (dpy, DefaultScreen (dpy)));
2760}
2761
9d317b2c
RS
2762DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
2763 Sx_server_max_request_size,
2764 0, 1, 0,
2765 "Returns the maximum request size of the X server FRAME is using.")
2766 (frame)
2767 Lisp_Object frame;
2768{
2769 Display *dpy = x_current_display;
2770 check_x ();
2771 return make_number (MAXREQUEST (dpy));
2772}
2773
41beb8fc
RS
2774DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
2775 "Returns the vendor ID string of the X server FRAME is on.")
2776 (frame)
2777 Lisp_Object frame;
2778{
2779 Display *dpy = x_current_display;
2780 char *vendor;
11ae94fe 2781 check_x ();
41beb8fc
RS
2782 vendor = ServerVendor (dpy);
2783 if (! vendor) vendor = "";
2784 return build_string (vendor);
2785}
2786
2787DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
2788 "Returns the version numbers of the X server in use.\n\
2789The value is a list of three integers: the major and minor\n\
2790version numbers of the X Protocol in use, and the vendor-specific release\n\
2791number. See also the variable `x-server-vendor'.")
2792 (frame)
2793 Lisp_Object frame;
2794{
2795 Display *dpy = x_current_display;
11ae94fe
RS
2796
2797 check_x ();
41beb8fc
RS
2798 return Fcons (make_number (ProtocolVersion (dpy)),
2799 Fcons (make_number (ProtocolRevision (dpy)),
2800 Fcons (make_number (VendorRelease (dpy)), Qnil)));
2801}
2802
2803DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
2804 "Returns the number of screens on the X server FRAME is on.")
2805 (frame)
2806 Lisp_Object frame;
2807{
11ae94fe 2808 check_x ();
41beb8fc
RS
2809 return make_number (ScreenCount (x_current_display));
2810}
2811
2812DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
2813 "Returns the height in millimeters of the X screen FRAME is on.")
2814 (frame)
2815 Lisp_Object frame;
2816{
11ae94fe 2817 check_x ();
41beb8fc
RS
2818 return make_number (HeightMMOfScreen (x_screen));
2819}
2820
2821DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
2822 "Returns the width in millimeters of the X screen FRAME is on.")
2823 (frame)
2824 Lisp_Object frame;
2825{
11ae94fe 2826 check_x ();
41beb8fc
RS
2827 return make_number (WidthMMOfScreen (x_screen));
2828}
2829
2830DEFUN ("x-display-backing-store", Fx_display_backing_store,
2831 Sx_display_backing_store, 0, 1, 0,
2832 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2833The value may be `always', `when-mapped', or `not-useful'.")
2834 (frame)
2835 Lisp_Object frame;
2836{
11ae94fe
RS
2837 check_x ();
2838
41beb8fc
RS
2839 switch (DoesBackingStore (x_screen))
2840 {
2841 case Always:
2842 return intern ("always");
2843
2844 case WhenMapped:
2845 return intern ("when-mapped");
2846
2847 case NotUseful:
2848 return intern ("not-useful");
2849
2850 default:
2851 error ("Strange value for BackingStore parameter of screen");
2852 }
2853}
2854
2855DEFUN ("x-display-visual-class", Fx_display_visual_class,
2856 Sx_display_visual_class, 0, 1, 0,
2857 "Returns the visual class of the display `screen' is on.\n\
2858The value is one of the symbols `static-gray', `gray-scale',\n\
2859`static-color', `pseudo-color', `true-color', or `direct-color'.")
2860 (screen)
2861 Lisp_Object screen;
2862{
11ae94fe
RS
2863 check_x ();
2864
41beb8fc
RS
2865 switch (screen_visual->class)
2866 {
2867 case StaticGray: return (intern ("static-gray"));
2868 case GrayScale: return (intern ("gray-scale"));
2869 case StaticColor: return (intern ("static-color"));
2870 case PseudoColor: return (intern ("pseudo-color"));
2871 case TrueColor: return (intern ("true-color"));
2872 case DirectColor: return (intern ("direct-color"));
2873 default:
2874 error ("Display has an unknown visual class");
2875 }
2876}
2877
2878DEFUN ("x-display-save-under", Fx_display_save_under,
2879 Sx_display_save_under, 0, 1, 0,
2880 "Returns t if the X screen FRAME is on supports the save-under feature.")
2881 (frame)
2882 Lisp_Object frame;
2883{
11ae94fe
RS
2884 check_x ();
2885
41beb8fc
RS
2886 if (DoesSaveUnders (x_screen) == True)
2887 return Qt;
2888 else
2889 return Qnil;
2890}
2891\f
55caf99c
RS
2892x_pixel_width (f)
2893 register struct frame *f;
01f1ba30 2894{
55caf99c 2895 return PIXEL_WIDTH (f);
01f1ba30
JB
2896}
2897
55caf99c
RS
2898x_pixel_height (f)
2899 register struct frame *f;
01f1ba30 2900{
55caf99c
RS
2901 return PIXEL_HEIGHT (f);
2902}
2903
2904x_char_width (f)
2905 register struct frame *f;
2906{
2907 return FONT_WIDTH (f->display.x->font);
2908}
2909
2910x_char_height (f)
2911 register struct frame *f;
2912{
2913 return FONT_HEIGHT (f->display.x->font);
01f1ba30
JB
2914}
2915\f
85ffea93
RS
2916#if 0 /* These no longer seem like the right way to do things. */
2917
f676886a 2918/* Draw a rectangle on the frame with left top corner including
01f1ba30
JB
2919 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2920 CHARS by LINES wide and long and is the color of the cursor. */
2921
2922void
f676886a
JB
2923x_rectangle (f, gc, left_char, top_char, chars, lines)
2924 register struct frame *f;
01f1ba30
JB
2925 GC gc;
2926 register int top_char, left_char, chars, lines;
2927{
2928 int width;
2929 int height;
f676886a
JB
2930 int left = (left_char * FONT_WIDTH (f->display.x->font)
2931 + f->display.x->internal_border_width);
2932 int top = (top_char * FONT_HEIGHT (f->display.x->font)
2933 + f->display.x->internal_border_width);
01f1ba30
JB
2934
2935 if (chars < 0)
f676886a 2936 width = FONT_WIDTH (f->display.x->font) / 2;
01f1ba30 2937 else
f676886a 2938 width = FONT_WIDTH (f->display.x->font) * chars;
01f1ba30 2939 if (lines < 0)
f676886a 2940 height = FONT_HEIGHT (f->display.x->font) / 2;
01f1ba30 2941 else
f676886a 2942 height = FONT_HEIGHT (f->display.x->font) * lines;
01f1ba30 2943
fe24a618 2944 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
2945 gc, left, top, width, height);
2946}
2947
2948DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
f676886a 2949 "Draw a rectangle on FRAME between coordinates specified by\n\
01f1ba30 2950numbers X0, Y0, X1, Y1 in the cursor pixel.")
f676886a
JB
2951 (frame, X0, Y0, X1, Y1)
2952 register Lisp_Object frame, X0, X1, Y0, Y1;
01f1ba30
JB
2953{
2954 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
2955
f676886a 2956 CHECK_LIVE_FRAME (frame, 0);
01f1ba30
JB
2957 CHECK_NUMBER (X0, 0);
2958 CHECK_NUMBER (Y0, 1);
2959 CHECK_NUMBER (X1, 2);
2960 CHECK_NUMBER (Y1, 3);
2961
2962 x0 = XINT (X0);
2963 x1 = XINT (X1);
2964 y0 = XINT (Y0);
2965 y1 = XINT (Y1);
2966
2967 if (y1 > y0)
2968 {
2969 top = y0;
2970 n_lines = y1 - y0 + 1;
2971 }
2972 else
2973 {
2974 top = y1;
2975 n_lines = y0 - y1 + 1;
2976 }
2977
2978 if (x1 > x0)
2979 {
2980 left = x0;
2981 n_chars = x1 - x0 + 1;
2982 }
2983 else
2984 {
2985 left = x1;
2986 n_chars = x0 - x1 + 1;
2987 }
2988
2989 BLOCK_INPUT;
f676886a 2990 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
01f1ba30
JB
2991 left, top, n_chars, n_lines);
2992 UNBLOCK_INPUT;
2993
2994 return Qt;
2995}
2996
2997DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
f676886a 2998 "Draw a rectangle drawn on FRAME between coordinates\n\
01f1ba30 2999X0, Y0, X1, Y1 in the regular background-pixel.")
f676886a
JB
3000 (frame, X0, Y0, X1, Y1)
3001 register Lisp_Object frame, X0, Y0, X1, Y1;
01f1ba30
JB
3002{
3003 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3004
f676886a 3005 CHECK_FRAME (frame, 0);
01f1ba30
JB
3006 CHECK_NUMBER (X0, 0);
3007 CHECK_NUMBER (Y0, 1);
3008 CHECK_NUMBER (X1, 2);
3009 CHECK_NUMBER (Y1, 3);
3010
3011 x0 = XINT (X0);
3012 x1 = XINT (X1);
3013 y0 = XINT (Y0);
3014 y1 = XINT (Y1);
3015
3016 if (y1 > y0)
3017 {
3018 top = y0;
3019 n_lines = y1 - y0 + 1;
3020 }
3021 else
3022 {
3023 top = y1;
3024 n_lines = y0 - y1 + 1;
3025 }
3026
3027 if (x1 > x0)
3028 {
3029 left = x0;
3030 n_chars = x1 - x0 + 1;
3031 }
3032 else
3033 {
3034 left = x1;
3035 n_chars = x0 - x1 + 1;
3036 }
3037
3038 BLOCK_INPUT;
f676886a 3039 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
01f1ba30
JB
3040 left, top, n_chars, n_lines);
3041 UNBLOCK_INPUT;
3042
3043 return Qt;
3044}
3045
3046/* Draw lines around the text region beginning at the character position
3047 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3048 pixel and line characteristics. */
3049
f676886a 3050#define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
01f1ba30
JB
3051
3052static void
f676886a
JB
3053outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
3054 register struct frame *f;
01f1ba30
JB
3055 GC gc;
3056 int top_x, top_y, bottom_x, bottom_y;
3057{
f676886a
JB
3058 register int ibw = f->display.x->internal_border_width;
3059 register int font_w = FONT_WIDTH (f->display.x->font);
3060 register int font_h = FONT_HEIGHT (f->display.x->font);
01f1ba30
JB
3061 int y = top_y;
3062 int x = line_len (y);
9ef48a9d
RS
3063 XPoint *pixel_points
3064 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
01f1ba30
JB
3065 register XPoint *this_point = pixel_points;
3066
3067 /* Do the horizontal top line/lines */
3068 if (top_x == 0)
3069 {
3070 this_point->x = ibw;
3071 this_point->y = ibw + (font_h * top_y);
3072 this_point++;
3073 if (x == 0)
3074 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
3075 else
3076 this_point->x = ibw + (font_w * x);
3077 this_point->y = (this_point - 1)->y;
3078 }
3079 else
3080 {
3081 this_point->x = ibw;
3082 this_point->y = ibw + (font_h * (top_y + 1));
3083 this_point++;
3084 this_point->x = ibw + (font_w * top_x);
3085 this_point->y = (this_point - 1)->y;
3086 this_point++;
3087 this_point->x = (this_point - 1)->x;
3088 this_point->y = ibw + (font_h * top_y);
3089 this_point++;
3090 this_point->x = ibw + (font_w * x);
3091 this_point->y = (this_point - 1)->y;
3092 }
3093
3094 /* Now do the right side. */
3095 while (y < bottom_y)
3096 { /* Right vertical edge */
3097 this_point++;
3098 this_point->x = (this_point - 1)->x;
3099 this_point->y = ibw + (font_h * (y + 1));
3100 this_point++;
3101
3102 y++; /* Horizontal connection to next line */
3103 x = line_len (y);
3104 if (x == 0)
3105 this_point->x = ibw + (font_w / 2);
3106 else
3107 this_point->x = ibw + (font_w * x);
3108
3109 this_point->y = (this_point - 1)->y;
3110 }
3111
3112 /* Now do the bottom and connect to the top left point. */
3113 this_point->x = ibw + (font_w * (bottom_x + 1));
3114
3115 this_point++;
3116 this_point->x = (this_point - 1)->x;
3117 this_point->y = ibw + (font_h * (bottom_y + 1));
3118 this_point++;
3119 this_point->x = ibw;
3120 this_point->y = (this_point - 1)->y;
3121 this_point++;
3122 this_point->x = pixel_points->x;
3123 this_point->y = pixel_points->y;
3124
fe24a618 3125 XDrawLines (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
3126 gc, pixel_points,
3127 (this_point - pixel_points + 1), CoordModeOrigin);
3128}
3129
3130DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
3131 "Highlight the region between point and the character under the mouse\n\
f676886a 3132selected frame.")
01f1ba30
JB
3133 (event)
3134 register Lisp_Object event;
3135{
3136 register int x0, y0, x1, y1;
f676886a 3137 register struct frame *f = selected_frame;
01f1ba30
JB
3138 register int p1, p2;
3139
3140 CHECK_CONS (event, 0);
3141
3142 BLOCK_INPUT;
3143 x0 = XINT (Fcar (Fcar (event)));
3144 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3145
3146 /* If the mouse is past the end of the line, don't that area. */
3147 /* ReWrite this... */
3148
f676886a
JB
3149 x1 = f->cursor_x;
3150 y1 = f->cursor_y;
01f1ba30
JB
3151
3152 if (y1 > y0) /* point below mouse */
f676886a 3153 outline_region (f, f->display.x->cursor_gc,
01f1ba30
JB
3154 x0, y0, x1, y1);
3155 else if (y1 < y0) /* point above mouse */
f676886a 3156 outline_region (f, f->display.x->cursor_gc,
01f1ba30
JB
3157 x1, y1, x0, y0);
3158 else /* same line: draw horizontal rectangle */
3159 {
3160 if (x1 > x0)
f676886a 3161 x_rectangle (f, f->display.x->cursor_gc,
01f1ba30
JB
3162 x0, y0, (x1 - x0 + 1), 1);
3163 else if (x1 < x0)
f676886a 3164 x_rectangle (f, f->display.x->cursor_gc,
01f1ba30
JB
3165 x1, y1, (x0 - x1 + 1), 1);
3166 }
3167
3168 XFlush (x_current_display);
3169 UNBLOCK_INPUT;
3170
3171 return Qnil;
3172}
3173
3174DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
3175 "Erase any highlighting of the region between point and the character\n\
f676886a 3176at X, Y on the selected frame.")
01f1ba30
JB
3177 (event)
3178 register Lisp_Object event;
3179{
3180 register int x0, y0, x1, y1;
f676886a 3181 register struct frame *f = selected_frame;
01f1ba30
JB
3182
3183 BLOCK_INPUT;
3184 x0 = XINT (Fcar (Fcar (event)));
3185 y0 = XINT (Fcar (Fcdr (Fcar (event))));
f676886a
JB
3186 x1 = f->cursor_x;
3187 y1 = f->cursor_y;
01f1ba30
JB
3188
3189 if (y1 > y0) /* point below mouse */
f676886a 3190 outline_region (f, f->display.x->reverse_gc,
01f1ba30
JB
3191 x0, y0, x1, y1);
3192 else if (y1 < y0) /* point above mouse */
f676886a 3193 outline_region (f, f->display.x->reverse_gc,
01f1ba30
JB
3194 x1, y1, x0, y0);
3195 else /* same line: draw horizontal rectangle */
3196 {
3197 if (x1 > x0)
f676886a 3198 x_rectangle (f, f->display.x->reverse_gc,
01f1ba30
JB
3199 x0, y0, (x1 - x0 + 1), 1);
3200 else if (x1 < x0)
f676886a 3201 x_rectangle (f, f->display.x->reverse_gc,
01f1ba30
JB
3202 x1, y1, (x0 - x1 + 1), 1);
3203 }
3204 UNBLOCK_INPUT;
3205
3206 return Qnil;
3207}
3208
01f1ba30
JB
3209#if 0
3210int contour_begin_x, contour_begin_y;
3211int contour_end_x, contour_end_y;
3212int contour_npoints;
3213
3214/* Clip the top part of the contour lines down (and including) line Y_POS.
3215 If X_POS is in the middle (rather than at the end) of the line, drop
3216 down a line at that character. */
3217
3218static void
3219clip_contour_top (y_pos, x_pos)
3220{
3221 register XPoint *begin = contour_lines[y_pos].top_left;
3222 register XPoint *end;
3223 register int npoints;
f676886a 3224 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
01f1ba30
JB
3225
3226 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
3227 {
3228 end = contour_lines[y_pos].top_right;
3229 npoints = (end - begin + 1);
3230 XDrawLines (x_current_display, contour_window,
3231 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3232
3233 bcopy (end, begin + 1, contour_last_point - end + 1);
3234 contour_last_point -= (npoints - 2);
3235 XDrawLines (x_current_display, contour_window,
3236 contour_erase_gc, begin, 2, CoordModeOrigin);
3237 XFlush (x_current_display);
3238
3239 /* Now, update contour_lines structure. */
3240 }
3241 /* ______. */
3242 else /* |________*/
3243 {
3244 register XPoint *p = begin + 1;
3245 end = contour_lines[y_pos].bottom_right;
3246 npoints = (end - begin + 1);
3247 XDrawLines (x_current_display, contour_window,
3248 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3249
3250 p->y = begin->y;
3251 p->x = ibw + (font_w * (x_pos + 1));
3252 p++;
3253 p->y = begin->y + font_h;
3254 p->x = (p - 1)->x;
3255 bcopy (end, begin + 3, contour_last_point - end + 1);
3256 contour_last_point -= (npoints - 5);
3257 XDrawLines (x_current_display, contour_window,
3258 contour_erase_gc, begin, 4, CoordModeOrigin);
3259 XFlush (x_current_display);
3260
3261 /* Now, update contour_lines structure. */
3262 }
3263}
3264
eb8c3be9 3265/* Erase the top horizontal lines of the contour, and then extend
01f1ba30
JB
3266 the contour upwards. */
3267
3268static void
3269extend_contour_top (line)
3270{
3271}
3272
3273static void
3274clip_contour_bottom (x_pos, y_pos)
3275 int x_pos, y_pos;
3276{
3277}
3278
3279static void
3280extend_contour_bottom (x_pos, y_pos)
3281{
3282}
3283
3284DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
3285 "")
3286 (event)
3287 Lisp_Object event;
3288{
f676886a
JB
3289 register struct frame *f = selected_frame;
3290 register int point_x = f->cursor_x;
3291 register int point_y = f->cursor_y;
01f1ba30
JB
3292 register int mouse_below_point;
3293 register Lisp_Object obj;
3294 register int x_contour_x, x_contour_y;
3295
3296 x_contour_x = x_mouse_x;
3297 x_contour_y = x_mouse_y;
3298 if (x_contour_y > point_y || (x_contour_y == point_y
3299 && x_contour_x > point_x))
3300 {
3301 mouse_below_point = 1;
f676886a 3302 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
01f1ba30
JB
3303 x_contour_x, x_contour_y);
3304 }
3305 else
3306 {
3307 mouse_below_point = 0;
f676886a 3308 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
01f1ba30
JB
3309 point_x, point_y);
3310 }
3311
3312 while (1)
3313 {
95be70ed 3314 obj = read_char (-1, 0, 0, Qnil, 0);
01f1ba30
JB
3315 if (XTYPE (obj) != Lisp_Cons)
3316 break;
3317
3318 if (mouse_below_point)
3319 {
3320 if (x_mouse_y <= point_y) /* Flipped. */
3321 {
3322 mouse_below_point = 0;
3323
f676886a 3324 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
01f1ba30 3325 x_contour_x, x_contour_y);
f676886a 3326 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
01f1ba30
JB
3327 point_x, point_y);
3328 }
3329 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
3330 {
3331 clip_contour_bottom (x_mouse_y);
3332 }
3333 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
3334 {
3335 extend_bottom_contour (x_mouse_y);
3336 }
3337
3338 x_contour_x = x_mouse_x;
3339 x_contour_y = x_mouse_y;
3340 }
3341 else /* mouse above or same line as point */
3342 {
3343 if (x_mouse_y >= point_y) /* Flipped. */
3344 {
3345 mouse_below_point = 1;
3346
f676886a 3347 outline_region (f, f->display.x->reverse_gc,
01f1ba30 3348 x_contour_x, x_contour_y, point_x, point_y);
f676886a 3349 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
01f1ba30
JB
3350 x_mouse_x, x_mouse_y);
3351 }
3352 else if (x_mouse_y > x_contour_y) /* Top clipped. */
3353 {
3354 clip_contour_top (x_mouse_y);
3355 }
3356 else if (x_mouse_y < x_contour_y) /* Top extended. */
3357 {
3358 extend_contour_top (x_mouse_y);
3359 }
3360 }
3361 }
3362
b4f5687c 3363 unread_command_event = obj;
01f1ba30
JB
3364 if (mouse_below_point)
3365 {
3366 contour_begin_x = point_x;
3367 contour_begin_y = point_y;
3368 contour_end_x = x_contour_x;
3369 contour_end_y = x_contour_y;
3370 }
3371 else
3372 {
3373 contour_begin_x = x_contour_x;
3374 contour_begin_y = x_contour_y;
3375 contour_end_x = point_x;
3376 contour_end_y = point_y;
3377 }
3378}
3379#endif
3380
3381DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
3382 "")
3383 (event)
3384 Lisp_Object event;
3385{
3386 register Lisp_Object obj;
f676886a 3387 struct frame *f = selected_frame;
01f1ba30 3388 register struct window *w = XWINDOW (selected_window);
f676886a
JB
3389 register GC line_gc = f->display.x->cursor_gc;
3390 register GC erase_gc = f->display.x->reverse_gc;
01f1ba30
JB
3391#if 0
3392 char dash_list[] = {6, 4, 6, 4};
3393 int dashes = 4;
3394 XGCValues gc_values;
3395#endif
3396 register int previous_y;
f676886a
JB
3397 register int line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
3398 + f->display.x->internal_border_width;
3399 register int left = f->display.x->internal_border_width
01f1ba30 3400 + (w->left
f676886a 3401 * FONT_WIDTH (f->display.x->font));
01f1ba30 3402 register int right = left + (w->width
f676886a
JB
3403 * FONT_WIDTH (f->display.x->font))
3404 - f->display.x->internal_border_width;
01f1ba30
JB
3405
3406#if 0
3407 BLOCK_INPUT;
f676886a
JB
3408 gc_values.foreground = f->display.x->cursor_pixel;
3409 gc_values.background = f->display.x->background_pixel;
01f1ba30
JB
3410 gc_values.line_width = 1;
3411 gc_values.line_style = LineOnOffDash;
3412 gc_values.cap_style = CapRound;
3413 gc_values.join_style = JoinRound;
3414
fe24a618 3415 line_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
3416 GCLineStyle | GCJoinStyle | GCCapStyle
3417 | GCLineWidth | GCForeground | GCBackground,
3418 &gc_values);
3419 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
f676886a
JB
3420 gc_values.foreground = f->display.x->background_pixel;
3421 gc_values.background = f->display.x->foreground_pixel;
fe24a618 3422 erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
3423 GCLineStyle | GCJoinStyle | GCCapStyle
3424 | GCLineWidth | GCForeground | GCBackground,
3425 &gc_values);
3426 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
3427#endif
3428
3429 while (1)
3430 {
3431 BLOCK_INPUT;
3432 if (x_mouse_y >= XINT (w->top)
3433 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3434 {
3435 previous_y = x_mouse_y;
f676886a
JB
3436 line = (x_mouse_y + 1) * FONT_HEIGHT (f->display.x->font)
3437 + f->display.x->internal_border_width;
fe24a618 3438 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
3439 line_gc, left, line, right, line);
3440 }
3441 XFlushQueue ();
3442 UNBLOCK_INPUT;
3443
3444 do
3445 {
95be70ed 3446 obj = read_char (-1, 0, 0, Qnil, 0);
01f1ba30
JB
3447 if ((XTYPE (obj) != Lisp_Cons)
3448 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
f9942c9e 3449 Qvertical_scroll_bar))
01f1ba30
JB
3450 || x_mouse_grabbed)
3451 {
3452 BLOCK_INPUT;
fe24a618 3453 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
3454 erase_gc, left, line, right, line);
3455 UNBLOCK_INPUT;
b4f5687c 3456 unread_command_event = obj;
01f1ba30
JB
3457#if 0
3458 XFreeGC (x_current_display, line_gc);
3459 XFreeGC (x_current_display, erase_gc);
3460#endif
3461 return Qnil;
3462 }
3463 }
3464 while (x_mouse_y == previous_y);
3465
3466 BLOCK_INPUT;
fe24a618 3467 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
01f1ba30
JB
3468 erase_gc, left, line, right, line);
3469 UNBLOCK_INPUT;
3470 }
3471}
06ef7355 3472#endif
01f1ba30 3473\f
01f1ba30
JB
3474/* Offset in buffer of character under the pointer, or 0. */
3475int mouse_buffer_offset;
3476
3477#if 0
3478/* These keep track of the rectangle following the pointer. */
3479int mouse_track_top, mouse_track_left, mouse_track_width;
3480
3481DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3482 "Track the pointer.")
3483 ()
3484{
3485 static Cursor current_pointer_shape;
f676886a 3486 FRAME_PTR f = x_mouse_frame;
01f1ba30
JB
3487
3488 BLOCK_INPUT;
f676886a
JB
3489 if (EQ (Vmouse_frame_part, Qtext_part)
3490 && (current_pointer_shape != f->display.x->nontext_cursor))
01f1ba30
JB
3491 {
3492 unsigned char c;
3493 struct buffer *buf;
3494
f676886a 3495 current_pointer_shape = f->display.x->nontext_cursor;
01f1ba30 3496 XDefineCursor (x_current_display,
fe24a618 3497 FRAME_X_WINDOW (f),
01f1ba30
JB
3498 current_pointer_shape);
3499
3500 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3501 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3502 }
f676886a
JB
3503 else if (EQ (Vmouse_frame_part, Qmodeline_part)
3504 && (current_pointer_shape != f->display.x->modeline_cursor))
01f1ba30 3505 {
f676886a 3506 current_pointer_shape = f->display.x->modeline_cursor;
01f1ba30 3507 XDefineCursor (x_current_display,
fe24a618 3508 FRAME_X_WINDOW (f),
01f1ba30
JB
3509 current_pointer_shape);
3510 }
3511
3512 XFlushQueue ();
3513 UNBLOCK_INPUT;
3514}
3515#endif
3516
3517#if 0
3518DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3519 "Draw rectangle around character under mouse pointer, if there is one.")
3520 (event)
3521 Lisp_Object event;
3522{
3523 struct window *w = XWINDOW (Vmouse_window);
f676886a 3524 struct frame *f = XFRAME (WINDOW_FRAME (w));
01f1ba30
JB
3525 struct buffer *b = XBUFFER (w->buffer);
3526 Lisp_Object obj;
3527
3528 if (! EQ (Vmouse_window, selected_window))
3529 return Qnil;
3530
3531 if (EQ (event, Qnil))
3532 {
3533 int x, y;
3534
f676886a 3535 x_read_mouse_position (selected_frame, &x, &y);
01f1ba30
JB
3536 }
3537
3538 BLOCK_INPUT;
3539 mouse_track_width = 0;
3540 mouse_track_left = mouse_track_top = -1;
3541
3542 do
3543 {
3544 if ((x_mouse_x != mouse_track_left
3545 && (x_mouse_x < mouse_track_left
3546 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3547 || x_mouse_y != mouse_track_top)
3548 {
3549 int hp = 0; /* Horizontal position */
f676886a
JB
3550 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
3551 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
01f1ba30 3552 int tab_width = XINT (b->tab_width);
265a9e55 3553 int ctl_arrow_p = !NILP (b->ctl_arrow);
01f1ba30
JB
3554 unsigned char c;
3555 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3556 int in_mode_line = 0;
3557
f676886a 3558 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
01f1ba30
JB
3559 break;
3560
3561 /* Erase previous rectangle. */
3562 if (mouse_track_width)
3563 {
f676886a 3564 x_rectangle (f, f->display.x->reverse_gc,
01f1ba30
JB
3565 mouse_track_left, mouse_track_top,
3566 mouse_track_width, 1);
3567
f676886a
JB
3568 if ((mouse_track_left == f->phys_cursor_x
3569 || mouse_track_left == f->phys_cursor_x - 1)
3570 && mouse_track_top == f->phys_cursor_y)
01f1ba30 3571 {
f676886a 3572 x_display_cursor (f, 1);
01f1ba30
JB
3573 }
3574 }
3575
3576 mouse_track_left = x_mouse_x;
3577 mouse_track_top = x_mouse_y;
3578 mouse_track_width = 0;
3579
3580 if (mouse_track_left > len) /* Past the end of line. */
3581 goto draw_or_not;
3582
3583 if (mouse_track_top == mode_line_vpos)
3584 {
3585 in_mode_line = 1;
3586 goto draw_or_not;
3587 }
3588
3589 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3590 do
3591 {
3592 c = FETCH_CHAR (p);
f676886a 3593 if (len == f->width && hp == len - 1 && c != '\n')
01f1ba30
JB
3594 goto draw_or_not;
3595
3596 switch (c)
3597 {
3598 case '\t':
3599 mouse_track_width = tab_width - (hp % tab_width);
3600 p++;
3601 hp += mouse_track_width;
3602 if (hp > x_mouse_x)
3603 {
3604 mouse_track_left = hp - mouse_track_width;
3605 goto draw_or_not;
3606 }
3607 continue;
3608
3609 case '\n':
3610 mouse_track_width = -1;
3611 goto draw_or_not;
3612
3613 default:
3614 if (ctl_arrow_p && (c < 040 || c == 0177))
3615 {
3616 if (p > ZV)
3617 goto draw_or_not;
3618
3619 mouse_track_width = 2;
3620 p++;
3621 hp +=2;
3622 if (hp > x_mouse_x)
3623 {
3624 mouse_track_left = hp - mouse_track_width;
3625 goto draw_or_not;
3626 }
3627 }
3628 else
3629 {
3630 mouse_track_width = 1;
3631 p++;
3632 hp++;
3633 }
3634 continue;
3635 }
3636 }
3637 while (hp <= x_mouse_x);
3638
3639 draw_or_not:
3640 if (mouse_track_width) /* Over text; use text pointer shape. */
3641 {
3642 XDefineCursor (x_current_display,
fe24a618 3643 FRAME_X_WINDOW (f),
f676886a
JB
3644 f->display.x->text_cursor);
3645 x_rectangle (f, f->display.x->cursor_gc,
01f1ba30
JB
3646 mouse_track_left, mouse_track_top,
3647 mouse_track_width, 1);
3648 }
3649 else if (in_mode_line)
3650 XDefineCursor (x_current_display,
fe24a618 3651 FRAME_X_WINDOW (f),
f676886a 3652 f->display.x->modeline_cursor);
01f1ba30
JB
3653 else
3654 XDefineCursor (x_current_display,
fe24a618 3655 FRAME_X_WINDOW (f),
f676886a 3656 f->display.x->nontext_cursor);
01f1ba30
JB
3657 }
3658
3659 XFlush (x_current_display);
3660 UNBLOCK_INPUT;
3661
95be70ed 3662 obj = read_char (-1, 0, 0, Qnil, 0);
01f1ba30
JB
3663 BLOCK_INPUT;
3664 }
3665 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
a3c87d4e 3666 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
01f1ba30
JB
3667 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3668 && EQ (Vmouse_window, selected_window) /* In this window */
f676886a 3669 && x_mouse_frame);
01f1ba30 3670
b4f5687c 3671 unread_command_event = obj;
01f1ba30
JB
3672
3673 if (mouse_track_width)
3674 {
f676886a 3675 x_rectangle (f, f->display.x->reverse_gc,
01f1ba30
JB
3676 mouse_track_left, mouse_track_top,
3677 mouse_track_width, 1);
3678 mouse_track_width = 0;
f676886a
JB
3679 if ((mouse_track_left == f->phys_cursor_x
3680 || mouse_track_left - 1 == f->phys_cursor_x)
3681 && mouse_track_top == f->phys_cursor_y)
01f1ba30 3682 {
f676886a 3683 x_display_cursor (f, 1);
01f1ba30
JB
3684 }
3685 }
3686 XDefineCursor (x_current_display,
fe24a618 3687 FRAME_X_WINDOW (f),
f676886a 3688 f->display.x->nontext_cursor);
01f1ba30
JB
3689 XFlush (x_current_display);
3690 UNBLOCK_INPUT;
3691
3692 return Qnil;
3693}
3694#endif
3695\f
3696#if 0
3697#include "glyphs.h"
3698
3699/* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
f676886a 3700 on the frame F at position X, Y. */
01f1ba30 3701
f676886a
JB
3702x_draw_pixmap (f, x, y, image_data, width, height)
3703 struct frame *f;
01f1ba30
JB
3704 int x, y, width, height;
3705 char *image_data;
3706{
3707 Pixmap image;
3708
3709 image = XCreateBitmapFromData (x_current_display,
fe24a618 3710 FRAME_X_WINDOW (f), image_data,
01f1ba30 3711 width, height);
fe24a618 3712 XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f),
f676886a 3713 f->display.x->normal_gc, 0, 0, width, height, x, y);
01f1ba30
JB
3714}
3715#endif
3716\f
01f1ba30
JB
3717#ifndef HAVE_X11
3718DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3719 1, 1, "sStore text in cut buffer: ",
3720 "Store contents of STRING into the cut buffer of the X window system.")
3721 (string)
3722 register Lisp_Object string;
3723{
3724 int mask;
3725
3726 CHECK_STRING (string, 1);
f9942c9e 3727 if (! FRAME_X_P (selected_frame))
f676886a 3728 error ("Selected frame does not understand X protocol.");
01f1ba30
JB
3729
3730 BLOCK_INPUT;
3731 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3732 UNBLOCK_INPUT;
3733
3734 return Qnil;
3735}
3736
3737DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3738 "Return contents of cut buffer of the X window system, as a string.")
3739 ()
3740{
3741 int len;
3742 register Lisp_Object string;
3743 int mask;
3744 register char *d;
3745
3746 BLOCK_INPUT;
3747 d = XFetchBytes (&len);
3748 string = make_string (d, len);
3749 XFree (d);
3750 UNBLOCK_INPUT;
3751 return string;
3752}
3753#endif /* X10 */
3754\f
01567351
RS
3755#if 0 /* I'm told these functions are superfluous
3756 given the ability to bind function keys. */
3757
01f1ba30
JB
3758#ifdef HAVE_X11
3759DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3760"Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3761KEYSYM is a string which conforms to the X keysym definitions found\n\
3762in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3763list of strings specifying modifier keys such as Control_L, which must\n\
3764also be depressed for NEWSTRING to appear.")
3765 (x_keysym, modifiers, newstring)
3766 register Lisp_Object x_keysym;
3767 register Lisp_Object modifiers;
3768 register Lisp_Object newstring;
3769{
3770 char *rawstring;
c047688c
JA
3771 register KeySym keysym;
3772 KeySym modifier_list[16];
01f1ba30 3773
11ae94fe 3774 check_x ();
01f1ba30
JB
3775 CHECK_STRING (x_keysym, 1);
3776 CHECK_STRING (newstring, 3);
3777
3778 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3779 if (keysym == NoSymbol)
3780 error ("Keysym does not exist");
3781
265a9e55 3782 if (NILP (modifiers))
01f1ba30
JB
3783 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3784 XSTRING (newstring)->data, XSTRING (newstring)->size);
3785 else
3786 {
3787 register Lisp_Object rest, mod;
3788 register int i = 0;
3789
265a9e55 3790 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
01f1ba30
JB
3791 {
3792 if (i == 16)
3793 error ("Can't have more than 16 modifiers");
3794
3795 mod = Fcar (rest);
3796 CHECK_STRING (mod, 3);
3797 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
fb351039
JB
3798#ifndef HAVE_X11R5
3799 if (modifier_list[i] == NoSymbol
3800 || !(IsModifierKey (modifier_list[i])
3801 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
3802 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
3803#else
01f1ba30
JB
3804 if (modifier_list[i] == NoSymbol
3805 || !IsModifierKey (modifier_list[i]))
fb351039 3806#endif
01f1ba30
JB
3807 error ("Element is not a modifier keysym");
3808 i++;
3809 }
3810
3811 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3812 XSTRING (newstring)->data, XSTRING (newstring)->size);
3813 }
3814
3815 return Qnil;
3816}
3817
3818DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3819 "Rebind KEYCODE to list of strings STRINGS.\n\
3820STRINGS should be a list of 16 elements, one for each shift combination.\n\
3821nil as element means don't change.\n\
3822See the documentation of `x-rebind-key' for more information.")
3823 (keycode, strings)
3824 register Lisp_Object keycode;
3825 register Lisp_Object strings;
3826{
3827 register Lisp_Object item;
3828 register unsigned char *rawstring;
3829 KeySym rawkey, modifier[1];
3830 int strsize;
3831 register unsigned i;
3832
11ae94fe 3833 check_x ();
01f1ba30
JB
3834 CHECK_NUMBER (keycode, 1);
3835 CHECK_CONS (strings, 2);
3836 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3837 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3838 {
3839 item = Fcar (strings);
265a9e55 3840 if (!NILP (item))
01f1ba30
JB
3841 {
3842 CHECK_STRING (item, 2);
3843 strsize = XSTRING (item)->size;
3844 rawstring = (unsigned char *) xmalloc (strsize);
3845 bcopy (XSTRING (item)->data, rawstring, strsize);
3846 modifier[1] = 1 << i;
3847 XRebindKeysym (x_current_display, rawkey, modifier, 1,
3848 rawstring, strsize);
3849 }
3850 }
3851 return Qnil;
3852}
9d04a87a 3853#endif /* HAVE_X11 */
01567351 3854#endif /* 0 */
01f1ba30
JB
3855\f
3856#ifdef HAVE_X11
404daac1
RS
3857
3858#ifndef HAVE_XSCREENNUMBEROFSCREEN
3859int
3860XScreenNumberOfScreen (scr)
3861 register Screen *scr;
3862{
3df34fdb
BF
3863 register Display *dpy;
3864 register Screen *dpyscr;
404daac1
RS
3865 register int i;
3866
3df34fdb
BF
3867 dpy = scr->display;
3868 dpyscr = dpy->screens;
3869
404daac1
RS
3870 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
3871 if (scr == dpyscr)
3872 return i;
3873
3874 return -1;
3875}
3876#endif /* not HAVE_XSCREENNUMBEROFSCREEN */
3877
01f1ba30
JB
3878Visual *
3879select_visual (screen, depth)
3880 Screen *screen;
3881 unsigned int *depth;
3882{
3883 Visual *v;
3884 XVisualInfo *vinfo, vinfo_template;
3885 int n_visuals;
3886
3887 v = DefaultVisualOfScreen (screen);
fe24a618
JB
3888
3889#ifdef HAVE_X11R4
3890 vinfo_template.visualid = XVisualIDFromVisual (v);
3891#else
6afb1d07 3892 vinfo_template.visualid = v->visualid;
fe24a618
JB
3893#endif
3894
f0614854
JB
3895 vinfo_template.screen = XScreenNumberOfScreen (screen);
3896
3897 vinfo = XGetVisualInfo (x_current_display,
3898 VisualIDMask | VisualScreenMask, &vinfo_template,
01f1ba30
JB
3899 &n_visuals);
3900 if (n_visuals != 1)
3901 fatal ("Can't get proper X visual info");
3902
3903 if ((1 << vinfo->depth) == vinfo->colormap_size)
3904 *depth = vinfo->depth;
3905 else
3906 {
3907 int i = 0;
3908 int n = vinfo->colormap_size - 1;
3909 while (n)
3910 {
3911 n = n >> 1;
3912 i++;
3913 }
3914 *depth = i;
3915 }
3916
3917 XFree ((char *) vinfo);
3918 return v;
3919}
3920#endif /* HAVE_X11 */
3921
3922DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
3923 1, 2, 0, "Open a connection to an X server.\n\
d387c960
JB
3924DISPLAY is the name of the display to connect to.\n\
3925Optional second arg XRM_STRING is a string of resources in xrdb format.")
01f1ba30
JB
3926 (display, xrm_string)
3927 Lisp_Object display, xrm_string;
3928{
3929 unsigned int n_planes;
01f1ba30
JB
3930 unsigned char *xrm_option;
3931
3932 CHECK_STRING (display, 0);
3933 if (x_current_display != 0)
3934 error ("X server connection is already initialized");
d387c960
JB
3935 if (! NILP (xrm_string))
3936 CHECK_STRING (xrm_string, 1);
01f1ba30
JB
3937
3938 /* This is what opens the connection and sets x_current_display.
3939 This also initializes many symbols, such as those used for input. */
3940 x_term_init (XSTRING (display)->data);
3941
01f1ba30
JB
3942#ifdef HAVE_X11
3943 XFASTINT (Vwindow_system_version) = 11;
3944
d387c960
JB
3945 if (! NILP (xrm_string))
3946 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
01f1ba30
JB
3947 else
3948 xrm_option = (unsigned char *) 0;
d387c960
JB
3949
3950 validate_x_resource_name ();
3951
a081bd37 3952 BLOCK_INPUT;
d387c960
JB
3953 xrdb = x_load_resources (x_current_display, xrm_option,
3954 (char *) XSTRING (Vx_resource_name)->data,
3955 EMACS_CLASS);
a081bd37 3956 UNBLOCK_INPUT;
f5db3b94 3957#ifdef HAVE_XRMSETDATABASE
eb5d618c
JB
3958 XrmSetDatabase (x_current_display, xrdb);
3959#else
01f1ba30 3960 x_current_display->db = xrdb;
eb5d618c 3961#endif
01f1ba30
JB
3962
3963 x_screen = DefaultScreenOfDisplay (x_current_display);
3964
01f1ba30 3965 screen_visual = select_visual (x_screen, &n_planes);
a6605e5c 3966 x_screen_planes = n_planes;
41beb8fc
RS
3967 x_screen_height = HeightOfScreen (x_screen);
3968 x_screen_width = WidthOfScreen (x_screen);
01f1ba30
JB
3969
3970 /* X Atoms used by emacs. */
99e72068 3971 Xatoms_of_xselect ();
01f1ba30 3972 BLOCK_INPUT;
3c254570
JA
3973 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
3974 False);
3975 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
3976 False);
3977 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
3978 False);
3979 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
3980 False);
3981 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
3982 False);
3983 Xatom_wm_configure_denied = XInternAtom (x_current_display,
3984 "WM_CONFIGURE_DENIED", False);
3985 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
3986 False);
01f1ba30
JB
3987 UNBLOCK_INPUT;
3988#else /* not HAVE_X11 */
3989 XFASTINT (Vwindow_system_version) = 10;
3990#endif /* not HAVE_X11 */
3991 return Qnil;
3992}
3993
3994DEFUN ("x-close-current-connection", Fx_close_current_connection,
3995 Sx_close_current_connection,
3996 0, 0, 0, "Close the connection to the current X server.")
3997 ()
3998{
4ffe73ce
KH
3999 /* Note: If we're going to call check_x here, then the fatal error
4000 can't happen. For the moment, this check is just for safety,
4001 so a user won't try out the function and get a crash. If it's
4002 really intended only to be called when killing emacs, then there's
4003 no reason for it to have a lisp interface at all. */
4004 check_x();
01f1ba30
JB
4005#ifdef HAVE_X11
4006 /* This is ONLY used when killing emacs; For switching displays
4007 we'll have to take care of setting CloseDownMode elsewhere. */
4008
4009 if (x_current_display)
4010 {
4011 BLOCK_INPUT;
4012 XSetCloseDownMode (x_current_display, DestroyAll);
4013 XCloseDisplay (x_current_display);
739f2f53 4014 x_current_display = 0;
01f1ba30
JB
4015 }
4016 else
4017 fatal ("No current X display connection to close\n");
4018#endif
4019 return Qnil;
4020}
4021
4022DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
4023 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4024If ON is nil, allow buffering of requests.\n\
4025Turning on synchronization prohibits the Xlib routines from buffering\n\
4026requests and seriously degrades performance, but makes debugging much\n\
4027easier.")
4028 (on)
4029 Lisp_Object on;
4030{
11ae94fe
RS
4031 check_x ();
4032
01f1ba30
JB
4033 XSynchronize (x_current_display, !EQ (on, Qnil));
4034
4035 return Qnil;
4036}
4037
6b7b1820
RS
4038/* Wait for responses to all X commands issued so far for FRAME. */
4039
4040void
4041x_sync (frame)
4042 Lisp_Object frame;
4043{
4e87f4d2 4044 BLOCK_INPUT;
6b7b1820 4045 XSync (x_current_display, False);
4e87f4d2 4046 UNBLOCK_INPUT;
6b7b1820 4047}
01f1ba30
JB
4048\f
4049syms_of_xfns ()
4050{
01f1ba30
JB
4051 /* This is zero if not using X windows. */
4052 x_current_display = 0;
4053
f9942c9e
JB
4054 /* The section below is built by the lisp expression at the top of the file,
4055 just above where these variables are declared. */
4056 /*&&& init symbols here &&&*/
4057 Qauto_raise = intern ("auto-raise");
4058 staticpro (&Qauto_raise);
4059 Qauto_lower = intern ("auto-lower");
4060 staticpro (&Qauto_lower);
4061 Qbackground_color = intern ("background-color");
4062 staticpro (&Qbackground_color);
dbc4e1c1
JB
4063 Qbar = intern ("bar");
4064 staticpro (&Qbar);
f9942c9e
JB
4065 Qborder_color = intern ("border-color");
4066 staticpro (&Qborder_color);
4067 Qborder_width = intern ("border-width");
4068 staticpro (&Qborder_width);
dbc4e1c1
JB
4069 Qbox = intern ("box");
4070 staticpro (&Qbox);
f9942c9e
JB
4071 Qcursor_color = intern ("cursor-color");
4072 staticpro (&Qcursor_color);
dbc4e1c1
JB
4073 Qcursor_type = intern ("cursor-type");
4074 staticpro (&Qcursor_type);
f9942c9e
JB
4075 Qfont = intern ("font");
4076 staticpro (&Qfont);
4077 Qforeground_color = intern ("foreground-color");
4078 staticpro (&Qforeground_color);
4079 Qgeometry = intern ("geometry");
4080 staticpro (&Qgeometry);
f9942c9e
JB
4081 Qicon_left = intern ("icon-left");
4082 staticpro (&Qicon_left);
4083 Qicon_top = intern ("icon-top");
4084 staticpro (&Qicon_top);
4085 Qicon_type = intern ("icon-type");
4086 staticpro (&Qicon_type);
f9942c9e
JB
4087 Qinternal_border_width = intern ("internal-border-width");
4088 staticpro (&Qinternal_border_width);
4089 Qleft = intern ("left");
4090 staticpro (&Qleft);
4091 Qmouse_color = intern ("mouse-color");
4092 staticpro (&Qmouse_color);
baaed68e
JB
4093 Qnone = intern ("none");
4094 staticpro (&Qnone);
f9942c9e
JB
4095 Qparent_id = intern ("parent-id");
4096 staticpro (&Qparent_id);
8af1d7ca
JB
4097 Qsuppress_icon = intern ("suppress-icon");
4098 staticpro (&Qsuppress_icon);
f9942c9e
JB
4099 Qtop = intern ("top");
4100 staticpro (&Qtop);
01f1ba30 4101 Qundefined_color = intern ("undefined-color");
f9942c9e 4102 staticpro (&Qundefined_color);
a3c87d4e
JB
4103 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
4104 staticpro (&Qvertical_scroll_bars);
49795535
JB
4105 Qvisibility = intern ("visibility");
4106 staticpro (&Qvisibility);
f9942c9e
JB
4107 Qwindow_id = intern ("window-id");
4108 staticpro (&Qwindow_id);
4109 Qx_frame_parameter = intern ("x-frame-parameter");
4110 staticpro (&Qx_frame_parameter);
9ef48a9d
RS
4111 Qx_resource_name = intern ("x-resource-name");
4112 staticpro (&Qx_resource_name);
f9942c9e
JB
4113 /* This is the end of symbol initialization. */
4114
01f1ba30
JB
4115 Fput (Qundefined_color, Qerror_conditions,
4116 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
4117 Fput (Qundefined_color, Qerror_message,
4118 build_string ("Undefined color"));
4119
f9942c9e
JB
4120 init_x_parm_symbols ();
4121
01f1ba30 4122 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
d387c960 4123 "The buffer offset of the character under the pointer.");
a6605e5c 4124 mouse_buffer_offset = 0;
01f1ba30 4125
16ae08a9 4126 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
d387c960 4127 "The shape of the pointer when over text.\n\
af01ef26
RS
4128Changing the value does not affect existing frames\n\
4129unless you set the mouse color.");
01f1ba30
JB
4130 Vx_pointer_shape = Qnil;
4131
d387c960
JB
4132 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4133 "The name Emacs uses to look up X resources; for internal use only.\n\
4134`x-get-resource' uses this as the first component of the instance name\n\
4135when requesting resource values.\n\
4136Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4137was invoked, or to the value specified with the `-name' or `-rn'\n\
4138switches, if present.");
4139 Vx_resource_name = Qnil;
ac63d3d6 4140
af01ef26 4141#if 0
01f1ba30
JB
4142 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
4143 "The shape of the pointer when not over text.");
af01ef26 4144#endif
01f1ba30
JB
4145 Vx_nontext_pointer_shape = Qnil;
4146
af01ef26 4147#if 0
01f1ba30 4148 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
06ef7355 4149 "The shape of the pointer when over the mode line.");
af01ef26 4150#endif
01f1ba30
JB
4151 Vx_mode_pointer_shape = Qnil;
4152
01f1ba30
JB
4153 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
4154 "A string indicating the foreground color of the cursor box.");
4155 Vx_cursor_fore_pixel = Qnil;
4156
4157 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
4158 "Non-nil if a mouse button is currently depressed.");
4159 Vmouse_depressed = Qnil;
4160
01f1ba30
JB
4161 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
4162 "t if no X window manager is in use.");
4163
4164#ifdef HAVE_X11
4165 defsubr (&Sx_get_resource);
85ffea93 4166#if 0
01f1ba30
JB
4167 defsubr (&Sx_draw_rectangle);
4168 defsubr (&Sx_erase_rectangle);
4169 defsubr (&Sx_contour_region);
4170 defsubr (&Sx_uncontour_region);
85ffea93 4171#endif
bcc426b4 4172 defsubr (&Sx_display_color_p);
f0614854 4173 defsubr (&Sx_list_fonts);
8af1d7ca 4174 defsubr (&Sx_color_defined_p);
9d317b2c 4175 defsubr (&Sx_server_max_request_size);
41beb8fc
RS
4176 defsubr (&Sx_server_vendor);
4177 defsubr (&Sx_server_version);
4178 defsubr (&Sx_display_pixel_width);
4179 defsubr (&Sx_display_pixel_height);
4180 defsubr (&Sx_display_mm_width);
4181 defsubr (&Sx_display_mm_height);
4182 defsubr (&Sx_display_screens);
4183 defsubr (&Sx_display_planes);
4184 defsubr (&Sx_display_color_cells);
4185 defsubr (&Sx_display_visual_class);
4186 defsubr (&Sx_display_backing_store);
4187 defsubr (&Sx_display_save_under);
01567351 4188#if 0
9d04a87a
RS
4189 defsubr (&Sx_rebind_key);
4190 defsubr (&Sx_rebind_keys);
01f1ba30 4191 defsubr (&Sx_track_pointer);
01f1ba30
JB
4192 defsubr (&Sx_grab_pointer);
4193 defsubr (&Sx_ungrab_pointer);
809ca691 4194#endif
01f1ba30
JB
4195#else
4196 defsubr (&Sx_get_default);
4197 defsubr (&Sx_store_cut_buffer);
4198 defsubr (&Sx_get_cut_buffer);
01f1ba30 4199#endif
8af1d7ca 4200 defsubr (&Sx_parse_geometry);
f676886a
JB
4201 defsubr (&Sx_create_frame);
4202 defsubr (&Sfocus_frame);
4203 defsubr (&Sunfocus_frame);
06ef7355 4204#if 0
01f1ba30 4205 defsubr (&Sx_horizontal_line);
06ef7355 4206#endif
01f1ba30
JB
4207 defsubr (&Sx_open_connection);
4208 defsubr (&Sx_close_current_connection);
4209 defsubr (&Sx_synchronize);
01f1ba30
JB
4210}
4211
4212#endif /* HAVE_X_WINDOWS */