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