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