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