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