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