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