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