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