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