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