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