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