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