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