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