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