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