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