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