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