* gnus.el (gnus-newsrc-to-gnus-format): Correct regexp which
[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 #include "blockinput.h"
37
38 #ifdef HAVE_X_WINDOWS
39 extern void abort ();
40
41 #ifndef VMS
42 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
43 #include "bitmaps/gray.xbm"
44 #else
45 #include <X11/bitmaps/gray>
46 #endif
47 #else
48 #include "[.bitmaps]gray.xbm"
49 #endif
50
51 #define min(a,b) ((a) < (b) ? (a) : (b))
52 #define max(a,b) ((a) > (b) ? (a) : (b))
53
54 #ifdef HAVE_X11
55 /* X Resource data base */
56 static XrmDatabase xrdb;
57
58 /* The class of this X application. */
59 #define EMACS_CLASS "Emacs"
60
61 /* The name we're using for this X application. */
62 Lisp_Object Vxrdb_name;
63
64 /* Title name and application name for X stuff. */
65 extern char *x_id_name;
66
67 /* The background and shape of the mouse pointer, and shape when not
68 over text or in the modeline. */
69 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
70
71 /* Color of chars displayed in cursor box. */
72 Lisp_Object Vx_cursor_fore_pixel;
73
74 /* The screen being used. */
75 static Screen *x_screen;
76
77 /* The X Visual we are using for X windows (the default) */
78 Visual *screen_visual;
79
80 /* Height of this X screen in pixels. */
81 int x_screen_height;
82
83 /* Width of this X screen in pixels. */
84 int x_screen_width;
85
86 /* Number of planes for this screen. */
87 int x_screen_planes;
88
89 /* Non nil if no window manager is in use. */
90 Lisp_Object Vx_no_window_manager;
91
92 /* `t' if a mouse button is depressed. */
93
94 Lisp_Object Vmouse_depressed;
95
96 extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed;
97
98 /* Atom for indicating window state to the window manager. */
99 extern Atom Xatom_wm_change_state;
100
101 /* Communication with window managers. */
102 extern Atom Xatom_wm_protocols;
103
104 /* Kinds of protocol things we may receive. */
105 extern Atom Xatom_wm_take_focus;
106 extern Atom Xatom_wm_save_yourself;
107 extern Atom Xatom_wm_delete_window;
108
109 /* Other WM communication */
110 extern Atom Xatom_wm_configure_denied; /* When our config request is denied */
111 extern Atom Xatom_wm_window_moved; /* When the WM moves us. */
112
113 #else /* X10 */
114
115 /* Default size of an Emacs window. */
116 static char *default_window = "=80x24+0+0";
117
118 #define MAXICID 80
119 char iconidentity[MAXICID];
120 #define ICONTAG "emacs@"
121 char minibuffer_iconidentity[MAXICID];
122 #define MINIBUFFER_ICONTAG "minibuffer@"
123
124 #endif /* X10 */
125
126 /* The last 23 bits of the timestamp of the last mouse button event. */
127 Time mouse_timestamp;
128
129 /* Evaluate this expression to rebuild the section of syms_of_xfns
130 that initializes and staticpros the symbols declared below. Note
131 that Emacs 18 has a bug that keeps C-x C-e from being able to
132 evaluate this expression.
133
134 (progn
135 ;; Accumulate a list of the symbols we want to initialize from the
136 ;; declarations at the top of the file.
137 (goto-char (point-min))
138 (search-forward "/\*&&& symbols declared here &&&*\/\n")
139 (let (symbol-list)
140 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
141 (setq symbol-list
142 (cons (buffer-substring (match-beginning 1) (match-end 1))
143 symbol-list))
144 (forward-line 1))
145 (setq symbol-list (nreverse symbol-list))
146 ;; Delete the section of syms_of_... where we initialize the symbols.
147 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
148 (let ((start (point)))
149 (while (looking-at "^ Q")
150 (forward-line 2))
151 (kill-region start (point)))
152 ;; Write a new symbol initialization section.
153 (while symbol-list
154 (insert (format " %s = intern (\"" (car symbol-list)))
155 (let ((start (point)))
156 (insert (substring (car symbol-list) 1))
157 (subst-char-in-region start (point) ?_ ?-))
158 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
159 (setq symbol-list (cdr symbol-list)))))
160
161 */
162
163 /*&&& symbols declared here &&&*/
164 Lisp_Object Qauto_raise;
165 Lisp_Object Qauto_lower;
166 Lisp_Object Qbackground_color;
167 Lisp_Object Qbar;
168 Lisp_Object Qborder_color;
169 Lisp_Object Qborder_width;
170 Lisp_Object Qbox;
171 Lisp_Object Qcursor_color;
172 Lisp_Object Qcursor_type;
173 Lisp_Object Qfont;
174 Lisp_Object Qforeground_color;
175 Lisp_Object Qgeometry;
176 /* Lisp_Object Qicon; */
177 Lisp_Object Qicon_left;
178 Lisp_Object Qicon_top;
179 Lisp_Object Qicon_type;
180 Lisp_Object Qinternal_border_width;
181 Lisp_Object Qleft;
182 Lisp_Object Qmouse_color;
183 Lisp_Object Qnone;
184 Lisp_Object Qparent_id;
185 Lisp_Object Qsuppress_icon;
186 Lisp_Object Qtop;
187 Lisp_Object Qundefined_color;
188 Lisp_Object Qvertical_scroll_bars;
189 Lisp_Object Qvisibility;
190 Lisp_Object Qwindow_id;
191 Lisp_Object Qx_frame_parameter;
192
193 /* The below are defined in frame.c. */
194 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
195 extern Lisp_Object Qunsplittable, Qmenu_bar_lines;
196
197 extern Lisp_Object Vwindow_system_version;
198
199 \f
200 /* Error if we are not connected to X. */
201 static void
202 check_x ()
203 {
204 if (x_current_display == 0)
205 error ("X windows are not in use or not initialized");
206 }
207
208 /* Return the Emacs frame-object corresponding to an X window.
209 It could be the frame's main window or an icon window. */
210
211 /* This function can be called during GC, so use XGCTYPE. */
212
213 struct frame *
214 x_window_to_frame (wdesc)
215 int wdesc;
216 {
217 Lisp_Object tail, frame;
218 struct frame *f;
219
220 for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
221 tail = XCONS (tail)->cdr)
222 {
223 frame = XCONS (tail)->car;
224 if (XGCTYPE (frame) != Lisp_Frame)
225 continue;
226 f = XFRAME (frame);
227 if (FRAME_X_WINDOW (f) == wdesc
228 || f->display.x->icon_desc == wdesc)
229 return f;
230 }
231 return 0;
232 }
233
234 \f
235 /* Connect the frame-parameter names for X frames
236 to the ways of passing the parameter values to the window system.
237
238 The name of a parameter, as a Lisp symbol,
239 has an `x-frame-parameter' property which is an integer in Lisp
240 but can be interpreted as an `enum x_frame_parm' in C. */
241
242 enum x_frame_parm
243 {
244 X_PARM_FOREGROUND_COLOR,
245 X_PARM_BACKGROUND_COLOR,
246 X_PARM_MOUSE_COLOR,
247 X_PARM_CURSOR_COLOR,
248 X_PARM_BORDER_COLOR,
249 X_PARM_ICON_TYPE,
250 X_PARM_FONT,
251 X_PARM_BORDER_WIDTH,
252 X_PARM_INTERNAL_BORDER_WIDTH,
253 X_PARM_NAME,
254 X_PARM_AUTORAISE,
255 X_PARM_AUTOLOWER,
256 X_PARM_VERT_SCROLL_BAR,
257 X_PARM_VISIBILITY,
258 X_PARM_MENU_BAR_LINES
259 };
260
261
262 struct x_frame_parm_table
263 {
264 char *name;
265 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
266 };
267
268 void x_set_foreground_color ();
269 void x_set_background_color ();
270 void x_set_mouse_color ();
271 void x_set_cursor_color ();
272 void x_set_border_color ();
273 void x_set_cursor_type ();
274 void x_set_icon_type ();
275 void x_set_font ();
276 void x_set_border_width ();
277 void x_set_internal_border_width ();
278 void x_explicitly_set_name ();
279 void x_set_autoraise ();
280 void x_set_autolower ();
281 void x_set_vertical_scroll_bars ();
282 void x_set_visibility ();
283 void x_set_menu_bar_lines ();
284
285 static struct x_frame_parm_table x_frame_parms[] =
286 {
287 "foreground-color", x_set_foreground_color,
288 "background-color", x_set_background_color,
289 "mouse-color", x_set_mouse_color,
290 "cursor-color", x_set_cursor_color,
291 "border-color", x_set_border_color,
292 "cursor-type", x_set_cursor_type,
293 "icon-type", x_set_icon_type,
294 "font", x_set_font,
295 "border-width", x_set_border_width,
296 "internal-border-width", x_set_internal_border_width,
297 "name", x_explicitly_set_name,
298 "auto-raise", x_set_autoraise,
299 "auto-lower", x_set_autolower,
300 "vertical-scroll-bars", x_set_vertical_scroll_bars,
301 "visibility", x_set_visibility,
302 "menu-bar-lines", x_set_menu_bar_lines,
303 };
304
305 /* Attach the `x-frame-parameter' properties to
306 the Lisp symbol names of parameters relevant to X. */
307
308 init_x_parm_symbols ()
309 {
310 int i;
311
312 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
313 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
314 make_number (i));
315 }
316 \f
317 /* Change the parameters of FRAME as specified by ALIST.
318 If a parameter is not specially recognized, do nothing;
319 otherwise call the `x_set_...' function for that parameter. */
320
321 void
322 x_set_frame_parameters (f, alist)
323 FRAME_PTR f;
324 Lisp_Object alist;
325 {
326 Lisp_Object tail;
327
328 /* If both of these parameters are present, it's more efficient to
329 set them both at once. So we wait until we've looked at the
330 entire list before we set them. */
331 Lisp_Object width, height;
332
333 /* Same here. */
334 Lisp_Object left, top;
335
336 /* Record in these vectors all the parms specified. */
337 Lisp_Object *parms;
338 Lisp_Object *values;
339 int i;
340
341 i = 0;
342 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
343 i++;
344
345 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
346 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
347
348 /* Extract parm names and values into those vectors. */
349
350 i = 0;
351 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
352 {
353 Lisp_Object elt, prop, val;
354
355 elt = Fcar (tail);
356 parms[i] = Fcar (elt);
357 values[i] = Fcdr (elt);
358 i++;
359 }
360
361 XSET (width, Lisp_Int, FRAME_WIDTH (f));
362 XSET (height, Lisp_Int, FRAME_HEIGHT (f));
363 XSET (top, Lisp_Int, f->display.x->top_pos);
364 XSET (left, Lisp_Int, f->display.x->left_pos);
365
366 /* Now process them in reverse of specified order. */
367 for (i--; i >= 0; i--)
368 {
369 Lisp_Object prop, val;
370
371 prop = parms[i];
372 val = values[i];
373
374 if (EQ (prop, Qwidth))
375 width = val;
376 else if (EQ (prop, Qheight))
377 height = val;
378 else if (EQ (prop, Qtop))
379 top = val;
380 else if (EQ (prop, Qleft))
381 left = val;
382 else
383 {
384 register Lisp_Object param_index = Fget (prop, Qx_frame_parameter);
385 register Lisp_Object old_value = get_frame_param (f, prop);
386
387 store_frame_param (f, prop, val);
388 if (XTYPE (param_index) == Lisp_Int
389 && XINT (param_index) >= 0
390 && (XINT (param_index)
391 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
392 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
393 }
394 }
395
396 /* Don't call these unless they've changed; the window may not actually
397 exist yet. */
398 {
399 Lisp_Object frame;
400
401 XSET (frame, Lisp_Frame, f);
402 if (XINT (width) != FRAME_WIDTH (f)
403 || XINT (height) != FRAME_HEIGHT (f))
404 Fset_frame_size (frame, width, height);
405 if (XINT (left) != f->display.x->left_pos
406 || XINT (top) != f->display.x->top_pos)
407 Fset_frame_position (frame, left, top);
408 }
409 }
410
411 /* Insert a description of internally-recorded parameters of frame X
412 into the parameter alist *ALISTPTR that is to be given to the user.
413 Only parameters that are specific to the X window system
414 and whose values are not correctly recorded in the frame's
415 param_alist need to be considered here. */
416
417 x_report_frame_params (f, alistptr)
418 struct frame *f;
419 Lisp_Object *alistptr;
420 {
421 char buf[16];
422
423 store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos));
424 store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos));
425 store_in_alist (alistptr, Qborder_width,
426 make_number (f->display.x->border_width));
427 store_in_alist (alistptr, Qinternal_border_width,
428 make_number (f->display.x->internal_border_width));
429 sprintf (buf, "%d", FRAME_X_WINDOW (f));
430 store_in_alist (alistptr, Qwindow_id,
431 build_string (buf));
432 store_in_alist (alistptr, Qvisibility,
433 (FRAME_VISIBLE_P (f) ? Qt
434 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
435 }
436 \f
437 /* Decide if color named COLOR is valid for the display
438 associated with the selected frame. */
439 int
440 defined_color (color, color_def)
441 char *color;
442 Color *color_def;
443 {
444 register int foo;
445 Colormap screen_colormap;
446
447 BLOCK_INPUT;
448 #ifdef HAVE_X11
449 screen_colormap
450 = DefaultColormap (x_current_display, XDefaultScreen (x_current_display));
451
452 foo = XParseColor (x_current_display, screen_colormap,
453 color, color_def)
454 && XAllocColor (x_current_display, screen_colormap, color_def);
455 #else
456 foo = XParseColor (color, color_def) && XGetHardwareColor (color_def);
457 #endif /* not HAVE_X11 */
458 UNBLOCK_INPUT;
459
460 if (foo)
461 return 1;
462 else
463 return 0;
464 }
465
466 /* Given a string ARG naming a color, compute a pixel value from it
467 suitable for screen F.
468 If F is not a color screen, return DEF (default) regardless of what
469 ARG says. */
470
471 int
472 x_decode_color (arg, def)
473 Lisp_Object arg;
474 int def;
475 {
476 Color cdef;
477
478 CHECK_STRING (arg, 0);
479
480 if (strcmp (XSTRING (arg)->data, "black") == 0)
481 return BLACK_PIX_DEFAULT;
482 else if (strcmp (XSTRING (arg)->data, "white") == 0)
483 return WHITE_PIX_DEFAULT;
484
485 #ifdef HAVE_X11
486 if (x_screen_planes == 1)
487 return def;
488 #else
489 if (DISPLAY_CELLS == 1)
490 return def;
491 #endif
492
493 if (defined_color (XSTRING (arg)->data, &cdef))
494 return cdef.pixel;
495 else
496 Fsignal (Qundefined_color, Fcons (arg, Qnil));
497 }
498 \f
499 /* Functions called only from `x_set_frame_param'
500 to set individual parameters.
501
502 If FRAME_X_WINDOW (f) is 0,
503 the frame is being created and its X-window does not exist yet.
504 In that case, just record the parameter's new value
505 in the standard place; do not attempt to change the window. */
506
507 void
508 x_set_foreground_color (f, arg, oldval)
509 struct frame *f;
510 Lisp_Object arg, oldval;
511 {
512 f->display.x->foreground_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
513 if (FRAME_X_WINDOW (f) != 0)
514 {
515 #ifdef HAVE_X11
516 BLOCK_INPUT;
517 XSetForeground (x_current_display, f->display.x->normal_gc,
518 f->display.x->foreground_pixel);
519 XSetBackground (x_current_display, f->display.x->reverse_gc,
520 f->display.x->foreground_pixel);
521 UNBLOCK_INPUT;
522 #endif /* HAVE_X11 */
523 recompute_basic_faces (f);
524 if (FRAME_VISIBLE_P (f))
525 redraw_frame (f);
526 }
527 }
528
529 void
530 x_set_background_color (f, arg, oldval)
531 struct frame *f;
532 Lisp_Object arg, oldval;
533 {
534 Pixmap temp;
535 int mask;
536
537 f->display.x->background_pixel = x_decode_color (arg, WHITE_PIX_DEFAULT);
538
539 if (FRAME_X_WINDOW (f) != 0)
540 {
541 BLOCK_INPUT;
542 #ifdef HAVE_X11
543 /* The main frame area. */
544 XSetBackground (x_current_display, f->display.x->normal_gc,
545 f->display.x->background_pixel);
546 XSetForeground (x_current_display, f->display.x->reverse_gc,
547 f->display.x->background_pixel);
548 XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f),
549 f->display.x->background_pixel);
550
551 #else
552 temp = XMakeTile (f->display.x->background_pixel);
553 XChangeBackground (FRAME_X_WINDOW (f), temp);
554 XFreePixmap (temp);
555 #endif /* not HAVE_X11 */
556 UNBLOCK_INPUT;
557
558 recompute_basic_faces (f);
559
560 if (FRAME_VISIBLE_P (f))
561 redraw_frame (f);
562 }
563 }
564
565 void
566 x_set_mouse_color (f, arg, oldval)
567 struct frame *f;
568 Lisp_Object arg, oldval;
569 {
570 Cursor cursor, nontext_cursor, mode_cursor;
571 int mask_color;
572
573 if (!EQ (Qnil, arg))
574 f->display.x->mouse_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
575 mask_color = f->display.x->background_pixel;
576 /* No invisible pointers. */
577 if (mask_color == f->display.x->mouse_pixel
578 && mask_color == f->display.x->background_pixel)
579 f->display.x->mouse_pixel = f->display.x->foreground_pixel;
580
581 BLOCK_INPUT;
582 #ifdef HAVE_X11
583
584 /* It's not okay to crash if the user selects a screwy cursor. */
585 x_catch_errors ();
586
587 if (!EQ (Qnil, Vx_pointer_shape))
588 {
589 CHECK_NUMBER (Vx_pointer_shape, 0);
590 cursor = XCreateFontCursor (x_current_display, XINT (Vx_pointer_shape));
591 }
592 else
593 cursor = XCreateFontCursor (x_current_display, XC_xterm);
594 x_check_errors ("bad text pointer cursor: %s");
595
596 if (!EQ (Qnil, Vx_nontext_pointer_shape))
597 {
598 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
599 nontext_cursor = XCreateFontCursor (x_current_display,
600 XINT (Vx_nontext_pointer_shape));
601 }
602 else
603 nontext_cursor = XCreateFontCursor (x_current_display, XC_left_ptr);
604 x_check_errors ("bad nontext pointer cursor: %s");
605
606 if (!EQ (Qnil, Vx_mode_pointer_shape))
607 {
608 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
609 mode_cursor = XCreateFontCursor (x_current_display,
610 XINT (Vx_mode_pointer_shape));
611 }
612 else
613 mode_cursor = XCreateFontCursor (x_current_display, XC_xterm);
614
615 /* Check and report errors with the above calls. */
616 x_check_errors ("can't set cursor shape: %s");
617 x_uncatch_errors ();
618
619 {
620 XColor fore_color, back_color;
621
622 fore_color.pixel = f->display.x->mouse_pixel;
623 back_color.pixel = mask_color;
624 XQueryColor (x_current_display,
625 DefaultColormap (x_current_display,
626 DefaultScreen (x_current_display)),
627 &fore_color);
628 XQueryColor (x_current_display,
629 DefaultColormap (x_current_display,
630 DefaultScreen (x_current_display)),
631 &back_color);
632 XRecolorCursor (x_current_display, cursor,
633 &fore_color, &back_color);
634 XRecolorCursor (x_current_display, nontext_cursor,
635 &fore_color, &back_color);
636 XRecolorCursor (x_current_display, mode_cursor,
637 &fore_color, &back_color);
638 }
639 #else /* X10 */
640 cursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
641 0, 0,
642 f->display.x->mouse_pixel,
643 f->display.x->background_pixel,
644 GXcopy);
645 #endif /* X10 */
646
647 if (FRAME_X_WINDOW (f) != 0)
648 {
649 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f), cursor);
650 }
651
652 if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0)
653 XFreeCursor (XDISPLAY f->display.x->text_cursor);
654 f->display.x->text_cursor = cursor;
655 #ifdef HAVE_X11
656 if (nontext_cursor != f->display.x->nontext_cursor
657 && f->display.x->nontext_cursor != 0)
658 XFreeCursor (XDISPLAY f->display.x->nontext_cursor);
659 f->display.x->nontext_cursor = nontext_cursor;
660
661 if (mode_cursor != f->display.x->modeline_cursor
662 && f->display.x->modeline_cursor != 0)
663 XFreeCursor (XDISPLAY f->display.x->modeline_cursor);
664 f->display.x->modeline_cursor = mode_cursor;
665 #endif /* HAVE_X11 */
666
667 XFlushQueue ();
668 UNBLOCK_INPUT;
669 }
670
671 void
672 x_set_cursor_color (f, arg, oldval)
673 struct frame *f;
674 Lisp_Object arg, oldval;
675 {
676 unsigned long fore_pixel;
677
678 if (!EQ (Vx_cursor_fore_pixel, Qnil))
679 fore_pixel = x_decode_color (Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT);
680 else
681 fore_pixel = f->display.x->background_pixel;
682 f->display.x->cursor_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
683
684 /* Make sure that the cursor color differs from the background color. */
685 if (f->display.x->cursor_pixel == f->display.x->background_pixel)
686 {
687 f->display.x->cursor_pixel == f->display.x->mouse_pixel;
688 if (f->display.x->cursor_pixel == fore_pixel)
689 fore_pixel = f->display.x->background_pixel;
690 }
691 f->display.x->cursor_foreground_pixel = fore_pixel;
692
693 if (FRAME_X_WINDOW (f) != 0)
694 {
695 #ifdef HAVE_X11
696 BLOCK_INPUT;
697 XSetBackground (x_current_display, f->display.x->cursor_gc,
698 f->display.x->cursor_pixel);
699 XSetForeground (x_current_display, f->display.x->cursor_gc,
700 fore_pixel);
701 UNBLOCK_INPUT;
702 #endif /* HAVE_X11 */
703
704 if (FRAME_VISIBLE_P (f))
705 {
706 x_display_cursor (f, 0);
707 x_display_cursor (f, 1);
708 }
709 }
710 }
711
712 /* Set the border-color of frame F to value described by ARG.
713 ARG can be a string naming a color.
714 The border-color is used for the border that is drawn by the X server.
715 Note that this does not fully take effect if done before
716 F has an x-window; it must be redone when the window is created.
717
718 Note: this is done in two routines because of the way X10 works.
719
720 Note: under X11, this is normally the province of the window manager,
721 and so emacs' border colors may be overridden. */
722
723 void
724 x_set_border_color (f, arg, oldval)
725 struct frame *f;
726 Lisp_Object arg, oldval;
727 {
728 unsigned char *str;
729 int pix;
730
731 CHECK_STRING (arg, 0);
732 str = XSTRING (arg)->data;
733
734 #ifndef HAVE_X11
735 if (!strcmp (str, "grey") || !strcmp (str, "Grey")
736 || !strcmp (str, "gray") || !strcmp (str, "Gray"))
737 pix = -1;
738 else
739 #endif /* X10 */
740
741 pix = x_decode_color (arg, BLACK_PIX_DEFAULT);
742
743 x_set_border_pixel (f, pix);
744 }
745
746 /* Set the border-color of frame F to pixel value PIX.
747 Note that this does not fully take effect if done before
748 F has an x-window. */
749
750 x_set_border_pixel (f, pix)
751 struct frame *f;
752 int pix;
753 {
754 f->display.x->border_pixel = pix;
755
756 if (FRAME_X_WINDOW (f) != 0 && f->display.x->border_width > 0)
757 {
758 Pixmap temp;
759 int mask;
760
761 BLOCK_INPUT;
762 #ifdef HAVE_X11
763 XSetWindowBorder (x_current_display, FRAME_X_WINDOW (f),
764 pix);
765 #else
766 if (pix < 0)
767 temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height,
768 gray_bits),
769 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
770 else
771 temp = XMakeTile (pix);
772 XChangeBorder (FRAME_X_WINDOW (f), temp);
773 XFreePixmap (XDISPLAY temp);
774 #endif /* not HAVE_X11 */
775 UNBLOCK_INPUT;
776
777 if (FRAME_VISIBLE_P (f))
778 redraw_frame (f);
779 }
780 }
781
782 void
783 x_set_cursor_type (f, arg, oldval)
784 FRAME_PTR f;
785 Lisp_Object arg, oldval;
786 {
787 if (EQ (arg, Qbar))
788 FRAME_DESIRED_CURSOR (f) = bar_cursor;
789 else
790 #if 0
791 if (EQ (arg, Qbox))
792 #endif
793 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
794 /* Error messages commented out because people have trouble fixing
795 .Xdefaults with Emacs, when it has something bad in it. */
796 #if 0
797 else
798 error
799 ("the `cursor-type' frame parameter should be either `bar' or `box'");
800 #endif
801
802 /* Make sure the cursor gets redrawn. This is overkill, but how
803 often do people change cursor types? */
804 update_mode_lines++;
805 }
806
807 void
808 x_set_icon_type (f, arg, oldval)
809 struct frame *f;
810 Lisp_Object arg, oldval;
811 {
812 Lisp_Object tem;
813 int result;
814
815 if (EQ (oldval, Qnil) == EQ (arg, Qnil))
816 return;
817
818 BLOCK_INPUT;
819 if (NILP (arg))
820 result = x_text_icon (f, 0);
821 else
822 result = x_bitmap_icon (f);
823
824 if (result)
825 {
826 UNBLOCK_INPUT;
827 error ("No icon window available.");
828 }
829
830 /* If the window was unmapped (and its icon was mapped),
831 the new icon is not mapped, so map the window in its stead. */
832 if (FRAME_VISIBLE_P (f))
833 XMapWindow (XDISPLAY FRAME_X_WINDOW (f));
834
835 XFlushQueue ();
836 UNBLOCK_INPUT;
837 }
838
839 extern Lisp_Object x_new_font ();
840
841 void
842 x_set_font (f, arg, oldval)
843 struct frame *f;
844 Lisp_Object arg, oldval;
845 {
846 Lisp_Object result;
847
848 CHECK_STRING (arg, 1);
849
850 BLOCK_INPUT;
851 result = x_new_font (f, XSTRING (arg)->data);
852 UNBLOCK_INPUT;
853
854 if (EQ (result, Qnil))
855 error ("Font \"%s\" is not defined", XSTRING (arg)->data);
856 else if (EQ (result, Qt))
857 error ("the characters of the given font have varying widths");
858 else if (STRINGP (result))
859 {
860 recompute_basic_faces (f);
861 store_frame_param (f, Qfont, result);
862 }
863 else
864 abort ();
865 }
866
867 void
868 x_set_border_width (f, arg, oldval)
869 struct frame *f;
870 Lisp_Object arg, oldval;
871 {
872 CHECK_NUMBER (arg, 0);
873
874 if (XINT (arg) == f->display.x->border_width)
875 return;
876
877 if (FRAME_X_WINDOW (f) != 0)
878 error ("Cannot change the border width of a window");
879
880 f->display.x->border_width = XINT (arg);
881 }
882
883 void
884 x_set_internal_border_width (f, arg, oldval)
885 struct frame *f;
886 Lisp_Object arg, oldval;
887 {
888 int mask;
889 int old = f->display.x->internal_border_width;
890
891 CHECK_NUMBER (arg, 0);
892 f->display.x->internal_border_width = XINT (arg);
893 if (f->display.x->internal_border_width < 0)
894 f->display.x->internal_border_width = 0;
895
896 if (f->display.x->internal_border_width == old)
897 return;
898
899 if (FRAME_X_WINDOW (f) != 0)
900 {
901 BLOCK_INPUT;
902 x_set_window_size (f, f->width, f->height);
903 #if 0
904 x_set_resize_hint (f);
905 #endif
906 XFlushQueue ();
907 UNBLOCK_INPUT;
908 SET_FRAME_GARBAGED (f);
909 }
910 }
911
912 void
913 x_set_visibility (f, value, oldval)
914 struct frame *f;
915 Lisp_Object value, oldval;
916 {
917 Lisp_Object frame;
918 XSET (frame, Lisp_Frame, f);
919
920 if (NILP (value))
921 Fmake_frame_invisible (frame);
922 else if (EQ (value, Qicon))
923 Ficonify_frame (frame);
924 else
925 Fmake_frame_visible (frame);
926 }
927
928 static void
929 x_set_menu_bar_lines_1 (window, n)
930 Lisp_Object window;
931 int n;
932 {
933 struct window *w = XWINDOW (window);
934
935 XFASTINT (w->top) += n;
936 XFASTINT (w->height) -= n;
937
938 /* Handle just the top child in a vertical split. */
939 if (!NILP (w->vchild))
940 x_set_menu_bar_lines_1 (w->vchild, n);
941
942 /* Adjust all children in a horizontal split. */
943 for (window = w->hchild; !NILP (window); window = w->next)
944 {
945 w = XWINDOW (window);
946 x_set_menu_bar_lines_1 (window, n);
947 }
948 }
949
950 void
951 x_set_menu_bar_lines (f, value, oldval)
952 struct frame *f;
953 Lisp_Object value, oldval;
954 {
955 int nlines;
956 int olines = FRAME_MENU_BAR_LINES (f);
957
958 /* Right now, menu bars don't work properly in minibuf-only frames;
959 most of the commands try to apply themselves to the minibuffer
960 frame itslef, and get an error because you can't switch buffers
961 in or split the minibuffer window. */
962 if (FRAME_MINIBUF_ONLY_P (f))
963 return;
964
965 if (XTYPE (value) == Lisp_Int)
966 nlines = XINT (value);
967 else
968 nlines = 0;
969
970 FRAME_MENU_BAR_LINES (f) = nlines;
971 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
972 }
973
974 /* Change the name of frame F to ARG. If ARG is nil, set F's name to
975 x_id_name.
976
977 If EXPLICIT is non-zero, that indicates that lisp code is setting the
978 name; if ARG is a string, set F's name to ARG and set
979 F->explicit_name; if ARG is Qnil, then clear F->explicit_name.
980
981 If EXPLICIT is zero, that indicates that Emacs redisplay code is
982 suggesting a new name, which lisp code should override; if
983 F->explicit_name is set, ignore the new name; otherwise, set it. */
984
985 void
986 x_set_name (f, name, explicit)
987 struct frame *f;
988 Lisp_Object name;
989 int explicit;
990 {
991 /* Make sure that requests from lisp code override requests from
992 Emacs redisplay code. */
993 if (explicit)
994 {
995 /* If we're switching from explicit to implicit, we had better
996 update the mode lines and thereby update the title. */
997 if (f->explicit_name && NILP (name))
998 update_mode_lines = 1;
999
1000 f->explicit_name = ! NILP (name);
1001 }
1002 else if (f->explicit_name)
1003 return;
1004
1005 /* If NAME is nil, set the name to the x_id_name. */
1006 if (NILP (name))
1007 name = build_string (x_id_name);
1008 else
1009 CHECK_STRING (name, 0);
1010
1011 /* Don't change the name if it's already NAME. */
1012 if (! NILP (Fstring_equal (name, f->name)))
1013 return;
1014
1015 if (FRAME_X_WINDOW (f))
1016 {
1017 BLOCK_INPUT;
1018
1019 #ifdef HAVE_X11R4
1020 {
1021 XTextProperty text;
1022 text.value = XSTRING (name)->data;
1023 text.encoding = XA_STRING;
1024 text.format = 8;
1025 text.nitems = XSTRING (name)->size;
1026 XSetWMName (x_current_display, FRAME_X_WINDOW (f), &text);
1027 XSetWMIconName (x_current_display, FRAME_X_WINDOW (f), &text);
1028 }
1029 #else
1030 XSetIconName (XDISPLAY FRAME_X_WINDOW (f),
1031 XSTRING (name)->data);
1032 XStoreName (XDISPLAY FRAME_X_WINDOW (f),
1033 XSTRING (name)->data);
1034 #endif
1035
1036 UNBLOCK_INPUT;
1037 }
1038
1039 f->name = name;
1040 }
1041
1042 /* This function should be called when the user's lisp code has
1043 specified a name for the frame; the name will override any set by the
1044 redisplay code. */
1045 void
1046 x_explicitly_set_name (f, arg, oldval)
1047 FRAME_PTR f;
1048 Lisp_Object arg, oldval;
1049 {
1050 x_set_name (f, arg, 1);
1051 }
1052
1053 /* This function should be called by Emacs redisplay code to set the
1054 name; names set this way will never override names set by the user's
1055 lisp code. */
1056 void
1057 x_implicitly_set_name (f, arg, oldval)
1058 FRAME_PTR f;
1059 Lisp_Object arg, oldval;
1060 {
1061 x_set_name (f, arg, 0);
1062 }
1063
1064 void
1065 x_set_autoraise (f, arg, oldval)
1066 struct frame *f;
1067 Lisp_Object arg, oldval;
1068 {
1069 f->auto_raise = !EQ (Qnil, arg);
1070 }
1071
1072 void
1073 x_set_autolower (f, arg, oldval)
1074 struct frame *f;
1075 Lisp_Object arg, oldval;
1076 {
1077 f->auto_lower = !EQ (Qnil, arg);
1078 }
1079
1080 void
1081 x_set_vertical_scroll_bars (f, arg, oldval)
1082 struct frame *f;
1083 Lisp_Object arg, oldval;
1084 {
1085 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1086 {
1087 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1088
1089 /* We set this parameter before creating the X window for the
1090 frame, so we can get the geometry right from the start.
1091 However, if the window hasn't been created yet, we shouldn't
1092 call x_set_window_size. */
1093 if (FRAME_X_WINDOW (f))
1094 x_set_window_size (f, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1095 }
1096 }
1097 \f
1098 /* Subroutines of creating an X frame. */
1099
1100 #ifdef HAVE_X11
1101 extern char *x_get_string_resource ();
1102 extern XrmDatabase x_load_resources ();
1103
1104 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1105 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1106 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1107 class, where INSTANCE is the name under which Emacs was invoked.\n\
1108 \n\
1109 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1110 class, respectively. You must specify both of them or neither.\n\
1111 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1112 and the class is `Emacs.CLASS.SUBCLASS'.")
1113 (attribute, class, component, subclass)
1114 Lisp_Object attribute, class, component, subclass;
1115 {
1116 register char *value;
1117 char *name_key;
1118 char *class_key;
1119
1120 check_x ();
1121
1122 CHECK_STRING (attribute, 0);
1123 CHECK_STRING (class, 0);
1124
1125 if (!NILP (component))
1126 CHECK_STRING (component, 1);
1127 if (!NILP (subclass))
1128 CHECK_STRING (subclass, 2);
1129 if (NILP (component) != NILP (subclass))
1130 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1131
1132 if (NILP (component))
1133 {
1134 /* Allocate space for the components, the dots which separate them,
1135 and the final '\0'. */
1136 name_key = (char *) alloca (XSTRING (Vxrdb_name)->size
1137 + XSTRING (attribute)->size
1138 + 2);
1139 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1140 + XSTRING (class)->size
1141 + 2);
1142
1143 sprintf (name_key, "%s.%s",
1144 XSTRING (Vxrdb_name)->data,
1145 XSTRING (attribute)->data);
1146 sprintf (class_key, "%s.%s",
1147 EMACS_CLASS,
1148 XSTRING (class)->data);
1149 }
1150 else
1151 {
1152 name_key = (char *) alloca (XSTRING (Vxrdb_name)->size
1153 + XSTRING (component)->size
1154 + XSTRING (attribute)->size
1155 + 3);
1156
1157 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1158 + XSTRING (class)->size
1159 + XSTRING (subclass)->size
1160 + 3);
1161
1162 sprintf (name_key, "%s.%s.%s",
1163 XSTRING (Vxrdb_name)->data,
1164 XSTRING (component)->data,
1165 XSTRING (attribute)->data);
1166 sprintf (class_key, "%s.%s.%s",
1167 EMACS_CLASS,
1168 XSTRING (class)->data,
1169 XSTRING (subclass)->data);
1170 }
1171
1172 value = x_get_string_resource (xrdb, name_key, class_key);
1173
1174 if (value != (char *) 0)
1175 return build_string (value);
1176 else
1177 return Qnil;
1178 }
1179
1180 /* Used when C code wants a resource value. */
1181
1182 char *
1183 x_get_resource_string (attribute, class)
1184 char *attribute, *class;
1185 {
1186 register char *value;
1187 char *name_key;
1188 char *class_key;
1189
1190 /* Allocate space for the components, the dots which separate them,
1191 and the final '\0'. */
1192 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1193 + strlen (attribute) + 2);
1194 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1195 + strlen (class) + 2);
1196
1197 sprintf (name_key, "%s.%s",
1198 XSTRING (Vinvocation_name)->data,
1199 attribute);
1200 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
1201
1202 return x_get_string_resource (xrdb, name_key, class_key);
1203 }
1204
1205 #else /* X10 */
1206
1207 DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
1208 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1209 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1210 The defaults are specified in the file `~/.Xdefaults'.")
1211 (arg)
1212 Lisp_Object arg;
1213 {
1214 register unsigned char *value;
1215
1216 CHECK_STRING (arg, 1);
1217
1218 value = (unsigned char *) XGetDefault (XDISPLAY
1219 XSTRING (Vinvocation_name)->data,
1220 XSTRING (arg)->data);
1221 if (value == 0)
1222 /* Try reversing last two args, in case this is the buggy version of X. */
1223 value = (unsigned char *) XGetDefault (XDISPLAY
1224 XSTRING (arg)->data,
1225 XSTRING (Vinvocation_name)->data);
1226 if (value != 0)
1227 return build_string (value);
1228 else
1229 return (Qnil);
1230 }
1231
1232 #define Fx_get_resource(attribute, class, component, subclass) \
1233 Fx_get_default(attribute)
1234
1235 #endif /* X10 */
1236
1237 /* Types we might convert a resource string into. */
1238 enum resource_types
1239 {
1240 number, boolean, string, symbol,
1241 };
1242
1243 /* Return the value of parameter PARAM.
1244
1245 First search ALIST, then Vdefault_frame_alist, then the X defaults
1246 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1247
1248 Convert the resource to the type specified by desired_type.
1249
1250 If no default is specified, return Qunbound. If you call
1251 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1252 and don't let it get stored in any lisp-visible variables! */
1253
1254 static Lisp_Object
1255 x_get_arg (alist, param, attribute, class, type)
1256 Lisp_Object alist, param;
1257 char *attribute;
1258 char *class;
1259 enum resource_types type;
1260 {
1261 register Lisp_Object tem;
1262
1263 tem = Fassq (param, alist);
1264 if (EQ (tem, Qnil))
1265 tem = Fassq (param, Vdefault_frame_alist);
1266 if (EQ (tem, Qnil))
1267 {
1268
1269 if (attribute)
1270 {
1271 tem = Fx_get_resource (build_string (attribute),
1272 build_string (class),
1273 Qnil, Qnil);
1274
1275 if (NILP (tem))
1276 return Qunbound;
1277
1278 switch (type)
1279 {
1280 case number:
1281 return make_number (atoi (XSTRING (tem)->data));
1282
1283 case boolean:
1284 tem = Fdowncase (tem);
1285 if (!strcmp (XSTRING (tem)->data, "on")
1286 || !strcmp (XSTRING (tem)->data, "true"))
1287 return Qt;
1288 else
1289 return Qnil;
1290
1291 case string:
1292 return tem;
1293
1294 case symbol:
1295 /* As a special case, we map the values `true' and `on'
1296 to Qt, and `false' and `off' to Qnil. */
1297 {
1298 Lisp_Object lower = Fdowncase (tem);
1299 if (!strcmp (XSTRING (tem)->data, "on")
1300 || !strcmp (XSTRING (tem)->data, "true"))
1301 return Qt;
1302 else if (!strcmp (XSTRING (tem)->data, "off")
1303 || !strcmp (XSTRING (tem)->data, "false"))
1304 return Qnil;
1305 else
1306 return Fintern (tem, Qnil);
1307 }
1308
1309 default:
1310 abort ();
1311 }
1312 }
1313 else
1314 return Qunbound;
1315 }
1316 return Fcdr (tem);
1317 }
1318
1319 /* Record in frame F the specified or default value according to ALIST
1320 of the parameter named PARAM (a Lisp symbol).
1321 If no value is specified for PARAM, look for an X default for XPROP
1322 on the frame named NAME.
1323 If that is not found either, use the value DEFLT. */
1324
1325 static Lisp_Object
1326 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
1327 struct frame *f;
1328 Lisp_Object alist;
1329 Lisp_Object prop;
1330 Lisp_Object deflt;
1331 char *xprop;
1332 char *xclass;
1333 enum resource_types type;
1334 {
1335 Lisp_Object tem;
1336
1337 tem = x_get_arg (alist, prop, xprop, xclass, type);
1338 if (EQ (tem, Qunbound))
1339 tem = deflt;
1340 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1341 return tem;
1342 }
1343 \f
1344 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
1345 "Parse an X-style geometry string STRING.\n\
1346 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).")
1347 (string)
1348 Lisp_Object string;
1349 {
1350 int geometry, x, y;
1351 unsigned int width, height;
1352 Lisp_Object values[4];
1353
1354 CHECK_STRING (string, 0);
1355
1356 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1357 &x, &y, &width, &height);
1358
1359 switch (geometry & 0xf) /* Mask out {X,Y}Negative */
1360 {
1361 case (XValue | YValue):
1362 /* What's one pixel among friends?
1363 Perhaps fix this some day by returning symbol `extreme-top'... */
1364 if (x == 0 && (geometry & XNegative))
1365 x = -1;
1366 if (y == 0 && (geometry & YNegative))
1367 y = -1;
1368 values[0] = Fcons (Qleft, make_number (x));
1369 values[1] = Fcons (Qtop, make_number (y));
1370 return Flist (2, values);
1371 break;
1372
1373 case (WidthValue | HeightValue):
1374 values[0] = Fcons (Qwidth, make_number (width));
1375 values[1] = Fcons (Qheight, make_number (height));
1376 return Flist (2, values);
1377 break;
1378
1379 case (XValue | YValue | WidthValue | HeightValue):
1380 if (x == 0 && (geometry & XNegative))
1381 x = -1;
1382 if (y == 0 && (geometry & YNegative))
1383 y = -1;
1384 values[0] = Fcons (Qwidth, make_number (width));
1385 values[1] = Fcons (Qheight, make_number (height));
1386 values[2] = Fcons (Qleft, make_number (x));
1387 values[3] = Fcons (Qtop, make_number (y));
1388 return Flist (4, values);
1389 break;
1390
1391 case 0:
1392 return Qnil;
1393
1394 default:
1395 error ("Must specify x and y value, and/or width and height");
1396 }
1397 }
1398
1399 #ifdef HAVE_X11
1400 /* Calculate the desired size and position of this window,
1401 or set rubber-band prompting if none. */
1402
1403 #define DEFAULT_ROWS 40
1404 #define DEFAULT_COLS 80
1405
1406 static int
1407 x_figure_window_size (f, parms)
1408 struct frame *f;
1409 Lisp_Object parms;
1410 {
1411 register Lisp_Object tem0, tem1;
1412 int height, width, left, top;
1413 register int geometry;
1414 long window_prompting = 0;
1415
1416 /* Default values if we fall through.
1417 Actually, if that happens we should get
1418 window manager prompting. */
1419 f->width = DEFAULT_COLS;
1420 f->height = DEFAULT_ROWS;
1421 /* Window managers expect that if program-specified
1422 positions are not (0,0), they're intentional, not defaults. */
1423 f->display.x->top_pos = 0;
1424 f->display.x->left_pos = 0;
1425
1426 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
1427 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
1428 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1429 {
1430 CHECK_NUMBER (tem0, 0);
1431 CHECK_NUMBER (tem1, 0);
1432 f->height = XINT (tem0);
1433 f->width = XINT (tem1);
1434 window_prompting |= USSize;
1435 }
1436 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1437 error ("Must specify *both* height and width");
1438
1439 f->display.x->vertical_scroll_bar_extra
1440 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1441 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f)
1442 : 0);
1443 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
1444 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
1445
1446 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
1447 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
1448 if (! EQ (tem0, Qunbound) && ! EQ (tem1, Qunbound))
1449 {
1450 CHECK_NUMBER (tem0, 0);
1451 CHECK_NUMBER (tem1, 0);
1452 f->display.x->top_pos = XINT (tem0);
1453 f->display.x->left_pos = XINT (tem1);
1454 x_calc_absolute_position (f);
1455 window_prompting |= USPosition;
1456 }
1457 else if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1458 error ("Must specify *both* top and left corners");
1459
1460 #if 0 /* PPosition and PSize mean "specified explicitly,
1461 by the program rather than by the user". So it is wrong to
1462 set them if nothing was specified. */
1463 switch (window_prompting)
1464 {
1465 case USSize | USPosition:
1466 return window_prompting;
1467 break;
1468
1469 case USSize: /* Got the size, need the position. */
1470 window_prompting |= PPosition;
1471 return window_prompting;
1472 break;
1473
1474 case USPosition: /* Got the position, need the size. */
1475 window_prompting |= PSize;
1476 return window_prompting;
1477 break;
1478
1479 case 0: /* Got nothing, take both from geometry. */
1480 window_prompting |= PPosition | PSize;
1481 return window_prompting;
1482 break;
1483
1484 default:
1485 /* Somehow a bit got set in window_prompting that we didn't
1486 put there. */
1487 abort ();
1488 }
1489 #endif
1490 return window_prompting;
1491 }
1492
1493 static void
1494 x_window (f)
1495 struct frame *f;
1496 {
1497 XSetWindowAttributes attributes;
1498 unsigned long attribute_mask;
1499 XClassHint class_hints;
1500
1501 attributes.background_pixel = f->display.x->background_pixel;
1502 attributes.border_pixel = f->display.x->border_pixel;
1503 attributes.bit_gravity = StaticGravity;
1504 attributes.backing_store = NotUseful;
1505 attributes.save_under = True;
1506 attributes.event_mask = STANDARD_EVENT_SET;
1507 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
1508 #if 0
1509 | CWBackingStore | CWSaveUnder
1510 #endif
1511 | CWEventMask);
1512
1513 BLOCK_INPUT;
1514 FRAME_X_WINDOW (f)
1515 = XCreateWindow (x_current_display, ROOT_WINDOW,
1516 f->display.x->left_pos,
1517 f->display.x->top_pos,
1518 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
1519 f->display.x->border_width,
1520 CopyFromParent, /* depth */
1521 InputOutput, /* class */
1522 screen_visual, /* set in Fx_open_connection */
1523 attribute_mask, &attributes);
1524
1525 class_hints.res_name = (char *) XSTRING (Vxrdb_name)->data;
1526 class_hints.res_class = EMACS_CLASS;
1527 XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
1528
1529 /* This indicates that we use the "Passive Input" input model.
1530 Unless we do this, we don't get the Focus{In,Out} events that we
1531 need to draw the cursor correctly. Accursed bureaucrats.
1532 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
1533
1534 f->display.x->wm_hints.input = True;
1535 f->display.x->wm_hints.flags |= InputHint;
1536 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
1537
1538 /* x_set_name normally ignores requests to set the name if the
1539 requested name is the same as the current name. This is the one
1540 place where that assumption isn't correct; f->name is set, but
1541 the X server hasn't been told. */
1542 {
1543 Lisp_Object name = f->name;
1544 int explicit = f->explicit_name;
1545
1546 f->name = Qnil;
1547 f->explicit_name = 0;
1548 x_set_name (f, name, explicit);
1549 }
1550
1551 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
1552 f->display.x->text_cursor);
1553 UNBLOCK_INPUT;
1554
1555 if (FRAME_X_WINDOW (f) == 0)
1556 error ("Unable to create window.");
1557 }
1558
1559 /* Handle the icon stuff for this window. Perhaps later we might
1560 want an x_set_icon_position which can be called interactively as
1561 well. */
1562
1563 static void
1564 x_icon (f, parms)
1565 struct frame *f;
1566 Lisp_Object parms;
1567 {
1568 Lisp_Object icon_x, icon_y;
1569
1570 /* Set the position of the icon. Note that twm groups all
1571 icons in an icon window. */
1572 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
1573 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
1574 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
1575 {
1576 CHECK_NUMBER (icon_x, 0);
1577 CHECK_NUMBER (icon_y, 0);
1578 }
1579 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
1580 error ("Both left and top icon corners of icon must be specified");
1581
1582 BLOCK_INPUT;
1583
1584 if (! EQ (icon_x, Qunbound))
1585 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
1586
1587 /* Start up iconic or window? */
1588 x_wm_set_window_state
1589 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
1590 ? IconicState
1591 : NormalState));
1592
1593 UNBLOCK_INPUT;
1594 }
1595
1596 /* Make the GC's needed for this window, setting the
1597 background, border and mouse colors; also create the
1598 mouse cursor and the gray border tile. */
1599
1600 static char cursor_bits[] =
1601 {
1602 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1603 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1604 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1605 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
1606 };
1607
1608 static void
1609 x_make_gc (f)
1610 struct frame *f;
1611 {
1612 XGCValues gc_values;
1613 GC temp_gc;
1614 XImage tileimage;
1615
1616 BLOCK_INPUT;
1617
1618 /* Create the GC's of this frame.
1619 Note that many default values are used. */
1620
1621 /* Normal video */
1622 gc_values.font = f->display.x->font->fid;
1623 gc_values.foreground = f->display.x->foreground_pixel;
1624 gc_values.background = f->display.x->background_pixel;
1625 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
1626 f->display.x->normal_gc = XCreateGC (x_current_display,
1627 FRAME_X_WINDOW (f),
1628 GCLineWidth | GCFont
1629 | GCForeground | GCBackground,
1630 &gc_values);
1631
1632 /* Reverse video style. */
1633 gc_values.foreground = f->display.x->background_pixel;
1634 gc_values.background = f->display.x->foreground_pixel;
1635 f->display.x->reverse_gc = XCreateGC (x_current_display,
1636 FRAME_X_WINDOW (f),
1637 GCFont | GCForeground | GCBackground
1638 | GCLineWidth,
1639 &gc_values);
1640
1641 /* Cursor has cursor-color background, background-color foreground. */
1642 gc_values.foreground = f->display.x->background_pixel;
1643 gc_values.background = f->display.x->cursor_pixel;
1644 gc_values.fill_style = FillOpaqueStippled;
1645 gc_values.stipple
1646 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
1647 cursor_bits, 16, 16);
1648 f->display.x->cursor_gc
1649 = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
1650 (GCFont | GCForeground | GCBackground
1651 | GCFillStyle | GCStipple | GCLineWidth),
1652 &gc_values);
1653
1654 /* Create the gray border tile used when the pointer is not in
1655 the frame. Since this depends on the frame's pixel values,
1656 this must be done on a per-frame basis. */
1657 f->display.x->border_tile
1658 = (XCreatePixmapFromBitmapData
1659 (x_current_display, ROOT_WINDOW,
1660 gray_bits, gray_width, gray_height,
1661 f->display.x->foreground_pixel,
1662 f->display.x->background_pixel,
1663 DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
1664
1665 UNBLOCK_INPUT;
1666 }
1667 #endif /* HAVE_X11 */
1668
1669 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1670 1, 1, 0,
1671 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
1672 Return an Emacs frame object representing the X window.\n\
1673 ALIST is an alist of frame parameters.\n\
1674 If the parameters specify that the frame should not have a minibuffer,\n\
1675 and do not specify a specific minibuffer window to use,\n\
1676 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
1677 be shared by the new frame.")
1678 (parms)
1679 Lisp_Object parms;
1680 {
1681 #ifdef HAVE_X11
1682 struct frame *f;
1683 Lisp_Object frame, tem;
1684 Lisp_Object name;
1685 int minibuffer_only = 0;
1686 long window_prompting = 0;
1687 int width, height;
1688
1689 check_x ();
1690
1691 name = x_get_arg (parms, Qname, "title", "Title", string);
1692 if (XTYPE (name) != Lisp_String
1693 && ! EQ (name, Qunbound)
1694 && ! NILP (name))
1695 error ("x-create-frame: name parameter must be a string");
1696
1697 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
1698 if (EQ (tem, Qnone) || NILP (tem))
1699 f = make_frame_without_minibuffer (Qnil);
1700 else if (EQ (tem, Qonly))
1701 {
1702 f = make_minibuffer_frame ();
1703 minibuffer_only = 1;
1704 }
1705 else if (XTYPE (tem) == Lisp_Window)
1706 f = make_frame_without_minibuffer (tem);
1707 else
1708 f = make_frame (1);
1709
1710 /* Note that X Windows does support scroll bars. */
1711 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
1712
1713 /* Set the name; the functions to which we pass f expect the name to
1714 be set. */
1715 if (EQ (name, Qunbound) || NILP (name))
1716 {
1717 f->name = build_string (x_id_name);
1718 f->explicit_name = 0;
1719 }
1720 else
1721 {
1722 f->name = name;
1723 f->explicit_name = 1;
1724 }
1725
1726 XSET (frame, Lisp_Frame, f);
1727 f->output_method = output_x_window;
1728 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1729 bzero (f->display.x, sizeof (struct x_display));
1730
1731 /* Note that the frame has no physical cursor right now. */
1732 f->phys_cursor_x = -1;
1733
1734 /* Extract the window parameters from the supplied values
1735 that are needed to determine window geometry. */
1736 x_default_parameter (f, parms, Qfont,
1737 build_string
1738 /* If we use an XLFD name for this font, the lisp code
1739 knows how to find variants which are bold, italic,
1740 etcetera. */
1741 ("-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1"),
1742 "font", "Font", string);
1743 x_default_parameter (f, parms, Qborder_width, make_number (2),
1744 "borderwidth", "BorderWidth", number);
1745 /* This defaults to 2 in order to match xterm. */
1746 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
1747 "internalBorderWidth", "BorderWidth", number);
1748 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
1749 "verticalScrollBars", "ScrollBars", boolean);
1750
1751 /* Also do the stuff which must be set before the window exists. */
1752 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
1753 "foreground", "Foreground", string);
1754 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
1755 "background", "Background", string);
1756 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
1757 "pointerColor", "Foreground", string);
1758 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
1759 "cursorColor", "Foreground", string);
1760 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
1761 "borderColor", "BorderColor", string);
1762
1763 f->display.x->parent_desc = ROOT_WINDOW;
1764 window_prompting = x_figure_window_size (f, parms);
1765
1766 x_window (f);
1767 x_icon (f, parms);
1768 x_make_gc (f);
1769 init_frame_faces (f);
1770
1771 /* We need to do this after creating the X window, so that the
1772 icon-creation functions can say whose icon they're describing. */
1773 x_default_parameter (f, parms, Qicon_type, Qnil,
1774 "bitmapIcon", "BitmapIcon", symbol);
1775
1776 x_default_parameter (f, parms, Qauto_raise, Qnil,
1777 "autoRaise", "AutoRaiseLower", boolean);
1778 x_default_parameter (f, parms, Qauto_lower, Qnil,
1779 "autoLower", "AutoRaiseLower", boolean);
1780 x_default_parameter (f, parms, Qcursor_type, Qbox,
1781 "cursorType", "CursorType", symbol);
1782
1783 /* Dimensions, especially f->height, must be done via change_frame_size.
1784 Change will not be effected unless different from the current
1785 f->height. */
1786 width = f->width;
1787 height = f->height;
1788 f->height = f->width = 0;
1789 change_frame_size (f, height, width, 1, 0);
1790
1791 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0),
1792 "menuBarLines", "MenuBarLines", number);
1793
1794 BLOCK_INPUT;
1795 x_wm_set_size_hint (f, window_prompting);
1796 UNBLOCK_INPUT;
1797
1798 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
1799 f->no_split = minibuffer_only || EQ (tem, Qt);
1800
1801 /* Make the window appear on the frame and enable display,
1802 unless the caller says not to. */
1803 {
1804 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
1805
1806 if (EQ (visibility, Qunbound))
1807 visibility = Qt;
1808
1809 if (EQ (visibility, Qicon))
1810 x_iconify_frame (f);
1811 else if (! NILP (visibility))
1812 x_make_frame_visible (f);
1813 else
1814 /* Must have been Qnil. */
1815 ;
1816 }
1817
1818 return frame;
1819 #else /* X10 */
1820 struct frame *f;
1821 Lisp_Object frame, tem;
1822 Lisp_Object name;
1823 int pixelwidth, pixelheight;
1824 Cursor cursor;
1825 int height, width;
1826 Window parent;
1827 Pixmap temp;
1828 int minibuffer_only = 0;
1829 Lisp_Object vscroll, hscroll;
1830
1831 if (x_current_display == 0)
1832 error ("X windows are not in use or not initialized");
1833
1834 name = Fassq (Qname, parms);
1835
1836 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
1837 if (EQ (tem, Qnone))
1838 f = make_frame_without_minibuffer (Qnil);
1839 else if (EQ (tem, Qonly))
1840 {
1841 f = make_minibuffer_frame ();
1842 minibuffer_only = 1;
1843 }
1844 else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
1845 f = make_frame (1);
1846 else
1847 f = make_frame_without_minibuffer (tem);
1848
1849 parent = ROOT_WINDOW;
1850
1851 XSET (frame, Lisp_Frame, f);
1852 f->output_method = output_x_window;
1853 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
1854 bzero (f->display.x, sizeof (struct x_display));
1855
1856 /* Some temporary default values for height and width. */
1857 width = 80;
1858 height = 40;
1859 f->display.x->left_pos = -1;
1860 f->display.x->top_pos = -1;
1861
1862 /* Give the frame a default name (which may be overridden with PARMS). */
1863
1864 strncpy (iconidentity, ICONTAG, MAXICID);
1865 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
1866 (MAXICID - 1) - sizeof (ICONTAG)))
1867 iconidentity[sizeof (ICONTAG) - 2] = '\0';
1868 f->name = build_string (iconidentity);
1869
1870 /* Extract some window parameters from the supplied values.
1871 These are the parameters that affect window geometry. */
1872
1873 tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
1874 if (EQ (tem, Qunbound))
1875 tem = build_string ("9x15");
1876 x_set_font (f, tem, Qnil);
1877 x_default_parameter (f, parms, Qborder_color,
1878 build_string ("black"), "Border", 0, string);
1879 x_default_parameter (f, parms, Qbackground_color,
1880 build_string ("white"), "Background", 0, string);
1881 x_default_parameter (f, parms, Qforeground_color,
1882 build_string ("black"), "Foreground", 0, string);
1883 x_default_parameter (f, parms, Qmouse_color,
1884 build_string ("black"), "Mouse", 0, string);
1885 x_default_parameter (f, parms, Qcursor_color,
1886 build_string ("black"), "Cursor", 0, string);
1887 x_default_parameter (f, parms, Qborder_width,
1888 make_number (2), "BorderWidth", 0, number);
1889 x_default_parameter (f, parms, Qinternal_border_width,
1890 make_number (4), "InternalBorderWidth", 0, number);
1891 x_default_parameter (f, parms, Qauto_raise,
1892 Qnil, "AutoRaise", 0, boolean);
1893
1894 hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
1895 vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
1896
1897 if (f->display.x->internal_border_width < 0)
1898 f->display.x->internal_border_width = 0;
1899
1900 tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
1901 if (!EQ (tem, Qunbound))
1902 {
1903 WINDOWINFO_TYPE wininfo;
1904 int nchildren;
1905 Window *children, root;
1906
1907 CHECK_NUMBER (tem, 0);
1908 FRAME_X_WINDOW (f) = (Window) XINT (tem);
1909
1910 BLOCK_INPUT;
1911 XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
1912 XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
1913 xfree (children);
1914 UNBLOCK_INPUT;
1915
1916 height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
1917 width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
1918 f->display.x->left_pos = wininfo.x;
1919 f->display.x->top_pos = wininfo.y;
1920 FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
1921 f->display.x->border_width = wininfo.bdrwidth;
1922 f->display.x->parent_desc = parent;
1923 }
1924 else
1925 {
1926 tem = x_get_arg (parms, Qparent_id, 0, 0, number);
1927 if (!EQ (tem, Qunbound))
1928 {
1929 CHECK_NUMBER (tem, 0);
1930 parent = (Window) XINT (tem);
1931 }
1932 f->display.x->parent_desc = parent;
1933 tem = x_get_arg (parms, Qheight, 0, 0, number);
1934 if (EQ (tem, Qunbound))
1935 {
1936 tem = x_get_arg (parms, Qwidth, 0, 0, number);
1937 if (EQ (tem, Qunbound))
1938 {
1939 tem = x_get_arg (parms, Qtop, 0, 0, number);
1940 if (EQ (tem, Qunbound))
1941 tem = x_get_arg (parms, Qleft, 0, 0, number);
1942 }
1943 }
1944 /* Now TEM is Qunbound if no edge or size was specified.
1945 In that case, we must do rubber-banding. */
1946 if (EQ (tem, Qunbound))
1947 {
1948 tem = x_get_arg (parms, Qgeometry, 0, 0, number);
1949 x_rubber_band (f,
1950 &f->display.x->left_pos, &f->display.x->top_pos,
1951 &width, &height,
1952 (XTYPE (tem) == Lisp_String
1953 ? (char *) XSTRING (tem)->data : ""),
1954 XSTRING (f->name)->data,
1955 !NILP (hscroll), !NILP (vscroll));
1956 }
1957 else
1958 {
1959 /* Here if at least one edge or size was specified.
1960 Demand that they all were specified, and use them. */
1961 tem = x_get_arg (parms, Qheight, 0, 0, number);
1962 if (EQ (tem, Qunbound))
1963 error ("Height not specified");
1964 CHECK_NUMBER (tem, 0);
1965 height = XINT (tem);
1966
1967 tem = x_get_arg (parms, Qwidth, 0, 0, number);
1968 if (EQ (tem, Qunbound))
1969 error ("Width not specified");
1970 CHECK_NUMBER (tem, 0);
1971 width = XINT (tem);
1972
1973 tem = x_get_arg (parms, Qtop, 0, 0, number);
1974 if (EQ (tem, Qunbound))
1975 error ("Top position not specified");
1976 CHECK_NUMBER (tem, 0);
1977 f->display.x->left_pos = XINT (tem);
1978
1979 tem = x_get_arg (parms, Qleft, 0, 0, number);
1980 if (EQ (tem, Qunbound))
1981 error ("Left position not specified");
1982 CHECK_NUMBER (tem, 0);
1983 f->display.x->top_pos = XINT (tem);
1984 }
1985
1986 pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
1987 pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
1988
1989 BLOCK_INPUT;
1990 FRAME_X_WINDOW (f)
1991 = XCreateWindow (parent,
1992 f->display.x->left_pos, /* Absolute horizontal offset */
1993 f->display.x->top_pos, /* Absolute Vertical offset */
1994 pixelwidth, pixelheight,
1995 f->display.x->border_width,
1996 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
1997 UNBLOCK_INPUT;
1998 if (FRAME_X_WINDOW (f) == 0)
1999 error ("Unable to create window.");
2000 }
2001
2002 /* Install the now determined height and width
2003 in the windows and in phys_lines and desired_lines. */
2004 change_frame_size (f, height, width, 1, 0);
2005 XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
2006 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2007 | EnterWindow | LeaveWindow | UnmapWindow );
2008 x_set_resize_hint (f);
2009
2010 /* Tell the server the window's default name. */
2011 XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
2012
2013 /* Now override the defaults with all the rest of the specified
2014 parms. */
2015 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2016 f->no_split = minibuffer_only || EQ (tem, Qt);
2017
2018 /* Do not create an icon window if the caller says not to */
2019 if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
2020 || f->display.x->parent_desc != ROOT_WINDOW)
2021 {
2022 x_text_icon (f, iconidentity);
2023 x_default_parameter (f, parms, Qicon_type, Qnil,
2024 "BitmapIcon", 0, symbol);
2025 }
2026
2027 /* Tell the X server the previously set values of the
2028 background, border and mouse colors; also create the mouse cursor. */
2029 BLOCK_INPUT;
2030 temp = XMakeTile (f->display.x->background_pixel);
2031 XChangeBackground (FRAME_X_WINDOW (f), temp);
2032 XFreePixmap (temp);
2033 UNBLOCK_INPUT;
2034 x_set_border_pixel (f, f->display.x->border_pixel);
2035
2036 x_set_mouse_color (f, Qnil, Qnil);
2037
2038 /* Now override the defaults with all the rest of the specified parms. */
2039
2040 Fmodify_frame_parameters (frame, parms);
2041
2042 /* Make the window appear on the frame and enable display. */
2043 {
2044 Lisp_Object visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2045
2046 if (EQ (visibility, Qunbound))
2047 visibility = Qt;
2048
2049 if (! EQ (visibility, Qicon)
2050 && ! NILP (visibility))
2051 x_make_window_visible (f);
2052 }
2053
2054 SET_FRAME_GARBAGED (f);
2055
2056 return frame;
2057 #endif /* X10 */
2058 }
2059
2060 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2061 "Set the focus on FRAME.")
2062 (frame)
2063 Lisp_Object frame;
2064 {
2065 CHECK_LIVE_FRAME (frame, 0);
2066
2067 if (FRAME_X_P (XFRAME (frame)))
2068 {
2069 BLOCK_INPUT;
2070 x_focus_on_frame (XFRAME (frame));
2071 UNBLOCK_INPUT;
2072 return frame;
2073 }
2074
2075 return Qnil;
2076 }
2077
2078 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2079 "If a frame has been focused, release it.")
2080 ()
2081 {
2082 if (x_focus_frame)
2083 {
2084 BLOCK_INPUT;
2085 x_unfocus_frame (x_focus_frame);
2086 UNBLOCK_INPUT;
2087 }
2088
2089 return Qnil;
2090 }
2091 \f
2092 #ifndef HAVE_X11
2093 /* Computes an X-window size and position either from geometry GEO
2094 or with the mouse.
2095
2096 F is a frame. It specifies an X window which is used to
2097 determine which display to compute for. Its font, borders
2098 and colors control how the rectangle will be displayed.
2099
2100 X and Y are where to store the positions chosen.
2101 WIDTH and HEIGHT are where to store the sizes chosen.
2102
2103 GEO is the geometry that may specify some of the info.
2104 STR is a prompt to display.
2105 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2106
2107 int
2108 x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
2109 struct frame *f;
2110 int *x, *y, *width, *height;
2111 char *geo;
2112 char *str;
2113 int hscroll, vscroll;
2114 {
2115 OpaqueFrame frame;
2116 Window tempwindow;
2117 WindowInfo wininfo;
2118 int border_color;
2119 int background_color;
2120 Lisp_Object tem;
2121 int mask;
2122
2123 BLOCK_INPUT;
2124
2125 background_color = f->display.x->background_pixel;
2126 border_color = f->display.x->border_pixel;
2127
2128 frame.bdrwidth = f->display.x->border_width;
2129 frame.border = XMakeTile (border_color);
2130 frame.background = XMakeTile (background_color);
2131 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
2132 (2 * f->display.x->internal_border_width
2133 + (vscroll ? VSCROLL_WIDTH : 0)),
2134 (2 * f->display.x->internal_border_width
2135 + (hscroll ? HSCROLL_HEIGHT : 0)),
2136 width, height, f->display.x->font,
2137 FONT_WIDTH (f->display.x->font),
2138 FONT_HEIGHT (f->display.x->font));
2139 XFreePixmap (frame.border);
2140 XFreePixmap (frame.background);
2141
2142 if (tempwindow != 0)
2143 {
2144 XQueryWindow (tempwindow, &wininfo);
2145 XDestroyWindow (tempwindow);
2146 *x = wininfo.x;
2147 *y = wininfo.y;
2148 }
2149
2150 /* Coordinates we got are relative to the root window.
2151 Convert them to coordinates relative to desired parent window
2152 by scanning from there up to the root. */
2153 tempwindow = f->display.x->parent_desc;
2154 while (tempwindow != ROOT_WINDOW)
2155 {
2156 int nchildren;
2157 Window *children;
2158 XQueryWindow (tempwindow, &wininfo);
2159 *x -= wininfo.x;
2160 *y -= wininfo.y;
2161 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
2162 xfree (children);
2163 }
2164
2165 UNBLOCK_INPUT;
2166 return tempwindow != 0;
2167 }
2168 #endif /* not HAVE_X11 */
2169 \f
2170 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
2171 "Return a list of the names of available fonts matching PATTERN.\n\
2172 If optional arguments FACE and FRAME are specified, return only fonts\n\
2173 the same size as FACE on FRAME.\n\
2174 \n\
2175 PATTERN is a string, perhaps with wildcard characters;\n\
2176 the * character matches any substring, and\n\
2177 the ? character matches any single character.\n\
2178 PATTERN is case-insensitive.\n\
2179 FACE is a face name - a symbol.\n\
2180 \n\
2181 The return value is a list of strings, suitable as arguments to\n\
2182 set-face-font.\n\
2183 \n\
2184 The list does not include fonts Emacs can't use (i.e. proportional\n\
2185 fonts), even if they match PATTERN and FACE.")
2186 (pattern, face, frame)
2187 Lisp_Object pattern, face, frame;
2188 {
2189 int num_fonts;
2190 char **names;
2191 XFontStruct *info;
2192 XFontStruct *size_ref;
2193 Lisp_Object list;
2194
2195 CHECK_STRING (pattern, 0);
2196 if (!NILP (face))
2197 CHECK_SYMBOL (face, 1);
2198 if (!NILP (frame))
2199 CHECK_LIVE_FRAME (frame, 2);
2200
2201 if (NILP (face))
2202 size_ref = 0;
2203 else
2204 {
2205 FRAME_PTR f = NILP (frame) ? selected_frame : XFRAME (frame);
2206 int face_id = face_name_id_number (f, face);
2207
2208 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
2209 || FRAME_PARAM_FACES (f) [face_id] == 0)
2210 size_ref = f->display.x->font;
2211 else
2212 {
2213 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
2214 if (size_ref == (XFontStruct *) (~0))
2215 size_ref = f->display.x->font;
2216 }
2217 }
2218
2219 BLOCK_INPUT;
2220 names = XListFontsWithInfo (x_current_display,
2221 XSTRING (pattern)->data,
2222 2000, /* maxnames */
2223 &num_fonts, /* count_return */
2224 &info); /* info_return */
2225 UNBLOCK_INPUT;
2226
2227 list = Qnil;
2228
2229 if (names)
2230 {
2231 Lisp_Object *tail;
2232 int i;
2233
2234 tail = &list;
2235 for (i = 0; i < num_fonts; i++)
2236 if (! size_ref
2237 || same_size_fonts (&info[i], size_ref))
2238 {
2239 *tail = Fcons (build_string (names[i]), Qnil);
2240 tail = &XCONS (*tail)->cdr;
2241 }
2242
2243 XFreeFontInfo (names, info, num_fonts);
2244 }
2245
2246 return list;
2247 }
2248
2249 \f
2250 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0,
2251 "Return t if the current X display supports the color named COLOR.")
2252 (color)
2253 Lisp_Object color;
2254 {
2255 Color foo;
2256
2257 check_x ();
2258 CHECK_STRING (color, 0);
2259
2260 if (defined_color (XSTRING (color)->data, &foo))
2261 return Qt;
2262 else
2263 return Qnil;
2264 }
2265
2266 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0,
2267 "Return t if the X screen currently in use supports color.")
2268 ()
2269 {
2270 check_x ();
2271
2272 if (x_screen_planes <= 2)
2273 return Qnil;
2274
2275 switch (screen_visual->class)
2276 {
2277 case StaticColor:
2278 case PseudoColor:
2279 case TrueColor:
2280 case DirectColor:
2281 return Qt;
2282
2283 default:
2284 return Qnil;
2285 }
2286 }
2287
2288 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2289 0, 1, 0,
2290 "Returns the width in pixels of the display FRAME is on.")
2291 (frame)
2292 Lisp_Object frame;
2293 {
2294 Display *dpy = x_current_display;
2295 check_x ();
2296 return make_number (DisplayWidth (dpy, DefaultScreen (dpy)));
2297 }
2298
2299 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2300 Sx_display_pixel_height, 0, 1, 0,
2301 "Returns the height in pixels of the display FRAME is on.")
2302 (frame)
2303 Lisp_Object frame;
2304 {
2305 Display *dpy = x_current_display;
2306 check_x ();
2307 return make_number (DisplayHeight (dpy, DefaultScreen (dpy)));
2308 }
2309
2310 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2311 0, 1, 0,
2312 "Returns the number of bitplanes of the display FRAME is on.")
2313 (frame)
2314 Lisp_Object frame;
2315 {
2316 Display *dpy = x_current_display;
2317 check_x ();
2318 return make_number (DisplayPlanes (dpy, DefaultScreen (dpy)));
2319 }
2320
2321 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2322 0, 1, 0,
2323 "Returns the number of color cells of the display FRAME is on.")
2324 (frame)
2325 Lisp_Object frame;
2326 {
2327 Display *dpy = x_current_display;
2328 check_x ();
2329 return make_number (DisplayCells (dpy, DefaultScreen (dpy)));
2330 }
2331
2332 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
2333 "Returns the vendor ID string of the X server FRAME is on.")
2334 (frame)
2335 Lisp_Object frame;
2336 {
2337 Display *dpy = x_current_display;
2338 char *vendor;
2339 check_x ();
2340 vendor = ServerVendor (dpy);
2341 if (! vendor) vendor = "";
2342 return build_string (vendor);
2343 }
2344
2345 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
2346 "Returns the version numbers of the X server in use.\n\
2347 The value is a list of three integers: the major and minor\n\
2348 version numbers of the X Protocol in use, and the vendor-specific release\n\
2349 number. See also the variable `x-server-vendor'.")
2350 (frame)
2351 Lisp_Object frame;
2352 {
2353 Display *dpy = x_current_display;
2354
2355 check_x ();
2356 return Fcons (make_number (ProtocolVersion (dpy)),
2357 Fcons (make_number (ProtocolRevision (dpy)),
2358 Fcons (make_number (VendorRelease (dpy)), Qnil)));
2359 }
2360
2361 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
2362 "Returns the number of screens on the X server FRAME is on.")
2363 (frame)
2364 Lisp_Object frame;
2365 {
2366 check_x ();
2367 return make_number (ScreenCount (x_current_display));
2368 }
2369
2370 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
2371 "Returns the height in millimeters of the X screen FRAME is on.")
2372 (frame)
2373 Lisp_Object frame;
2374 {
2375 check_x ();
2376 return make_number (HeightMMOfScreen (x_screen));
2377 }
2378
2379 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
2380 "Returns the width in millimeters of the X screen FRAME is on.")
2381 (frame)
2382 Lisp_Object frame;
2383 {
2384 check_x ();
2385 return make_number (WidthMMOfScreen (x_screen));
2386 }
2387
2388 DEFUN ("x-display-backing-store", Fx_display_backing_store,
2389 Sx_display_backing_store, 0, 1, 0,
2390 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2391 The value may be `always', `when-mapped', or `not-useful'.")
2392 (frame)
2393 Lisp_Object frame;
2394 {
2395 check_x ();
2396
2397 switch (DoesBackingStore (x_screen))
2398 {
2399 case Always:
2400 return intern ("always");
2401
2402 case WhenMapped:
2403 return intern ("when-mapped");
2404
2405 case NotUseful:
2406 return intern ("not-useful");
2407
2408 default:
2409 error ("Strange value for BackingStore parameter of screen");
2410 }
2411 }
2412
2413 DEFUN ("x-display-visual-class", Fx_display_visual_class,
2414 Sx_display_visual_class, 0, 1, 0,
2415 "Returns the visual class of the display `screen' is on.\n\
2416 The value is one of the symbols `static-gray', `gray-scale',\n\
2417 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2418 (screen)
2419 Lisp_Object screen;
2420 {
2421 check_x ();
2422
2423 switch (screen_visual->class)
2424 {
2425 case StaticGray: return (intern ("static-gray"));
2426 case GrayScale: return (intern ("gray-scale"));
2427 case StaticColor: return (intern ("static-color"));
2428 case PseudoColor: return (intern ("pseudo-color"));
2429 case TrueColor: return (intern ("true-color"));
2430 case DirectColor: return (intern ("direct-color"));
2431 default:
2432 error ("Display has an unknown visual class");
2433 }
2434 }
2435
2436 DEFUN ("x-display-save-under", Fx_display_save_under,
2437 Sx_display_save_under, 0, 1, 0,
2438 "Returns t if the X screen FRAME is on supports the save-under feature.")
2439 (frame)
2440 Lisp_Object frame;
2441 {
2442 check_x ();
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 horizontal 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 #ifndef HAVE_X11
3276 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3277 1, 1, "sStore text in cut buffer: ",
3278 "Store contents of STRING into the cut buffer of the X window system.")
3279 (string)
3280 register Lisp_Object string;
3281 {
3282 int mask;
3283
3284 CHECK_STRING (string, 1);
3285 if (! FRAME_X_P (selected_frame))
3286 error ("Selected frame does not understand X protocol.");
3287
3288 BLOCK_INPUT;
3289 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3290 UNBLOCK_INPUT;
3291
3292 return Qnil;
3293 }
3294
3295 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3296 "Return contents of cut buffer of the X window system, as a string.")
3297 ()
3298 {
3299 int len;
3300 register Lisp_Object string;
3301 int mask;
3302 register char *d;
3303
3304 BLOCK_INPUT;
3305 d = XFetchBytes (&len);
3306 string = make_string (d, len);
3307 XFree (d);
3308 UNBLOCK_INPUT;
3309 return string;
3310 }
3311 #endif /* X10 */
3312 \f
3313 #ifdef HAVE_X11
3314 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3315 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3316 KEYSYM is a string which conforms to the X keysym definitions found\n\
3317 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3318 list of strings specifying modifier keys such as Control_L, which must\n\
3319 also be depressed for NEWSTRING to appear.")
3320 (x_keysym, modifiers, newstring)
3321 register Lisp_Object x_keysym;
3322 register Lisp_Object modifiers;
3323 register Lisp_Object newstring;
3324 {
3325 char *rawstring;
3326 register KeySym keysym;
3327 KeySym modifier_list[16];
3328
3329 check_x ();
3330 CHECK_STRING (x_keysym, 1);
3331 CHECK_STRING (newstring, 3);
3332
3333 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3334 if (keysym == NoSymbol)
3335 error ("Keysym does not exist");
3336
3337 if (NILP (modifiers))
3338 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3339 XSTRING (newstring)->data, XSTRING (newstring)->size);
3340 else
3341 {
3342 register Lisp_Object rest, mod;
3343 register int i = 0;
3344
3345 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
3346 {
3347 if (i == 16)
3348 error ("Can't have more than 16 modifiers");
3349
3350 mod = Fcar (rest);
3351 CHECK_STRING (mod, 3);
3352 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
3353 #ifndef HAVE_X11R5
3354 if (modifier_list[i] == NoSymbol
3355 || !(IsModifierKey (modifier_list[i])
3356 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
3357 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
3358 #else
3359 if (modifier_list[i] == NoSymbol
3360 || !IsModifierKey (modifier_list[i]))
3361 #endif
3362 error ("Element is not a modifier keysym");
3363 i++;
3364 }
3365
3366 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3367 XSTRING (newstring)->data, XSTRING (newstring)->size);
3368 }
3369
3370 return Qnil;
3371 }
3372
3373 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3374 "Rebind KEYCODE to list of strings STRINGS.\n\
3375 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3376 nil as element means don't change.\n\
3377 See the documentation of `x-rebind-key' for more information.")
3378 (keycode, strings)
3379 register Lisp_Object keycode;
3380 register Lisp_Object strings;
3381 {
3382 register Lisp_Object item;
3383 register unsigned char *rawstring;
3384 KeySym rawkey, modifier[1];
3385 int strsize;
3386 register unsigned i;
3387
3388 check_x ();
3389 CHECK_NUMBER (keycode, 1);
3390 CHECK_CONS (strings, 2);
3391 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3392 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3393 {
3394 item = Fcar (strings);
3395 if (!NILP (item))
3396 {
3397 CHECK_STRING (item, 2);
3398 strsize = XSTRING (item)->size;
3399 rawstring = (unsigned char *) xmalloc (strsize);
3400 bcopy (XSTRING (item)->data, rawstring, strsize);
3401 modifier[1] = 1 << i;
3402 XRebindKeysym (x_current_display, rawkey, modifier, 1,
3403 rawstring, strsize);
3404 }
3405 }
3406 return Qnil;
3407 }
3408 #endif /* HAVE_X11 */
3409 \f
3410 #ifdef HAVE_X11
3411 Visual *
3412 select_visual (screen, depth)
3413 Screen *screen;
3414 unsigned int *depth;
3415 {
3416 Visual *v;
3417 XVisualInfo *vinfo, vinfo_template;
3418 int n_visuals;
3419
3420 v = DefaultVisualOfScreen (screen);
3421
3422 #ifdef HAVE_X11R4
3423 vinfo_template.visualid = XVisualIDFromVisual (v);
3424 #else
3425 vinfo_template.visualid = v->visualid;
3426 #endif
3427
3428 vinfo_template.screen = XScreenNumberOfScreen (screen);
3429
3430 vinfo = XGetVisualInfo (x_current_display,
3431 VisualIDMask | VisualScreenMask, &vinfo_template,
3432 &n_visuals);
3433 if (n_visuals != 1)
3434 fatal ("Can't get proper X visual info");
3435
3436 if ((1 << vinfo->depth) == vinfo->colormap_size)
3437 *depth = vinfo->depth;
3438 else
3439 {
3440 int i = 0;
3441 int n = vinfo->colormap_size - 1;
3442 while (n)
3443 {
3444 n = n >> 1;
3445 i++;
3446 }
3447 *depth = i;
3448 }
3449
3450 XFree ((char *) vinfo);
3451 return v;
3452 }
3453 #endif /* HAVE_X11 */
3454
3455 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
3456 1, 2, 0, "Open a connection to an X server.\n\
3457 DISPLAY is the name of the display to connect to. Optional second\n\
3458 arg XRM_STRING is a string of resources in xrdb format.")
3459 (display, xrm_string)
3460 Lisp_Object display, xrm_string;
3461 {
3462 unsigned int n_planes;
3463 unsigned char *xrm_option;
3464
3465 CHECK_STRING (display, 0);
3466 if (x_current_display != 0)
3467 error ("X server connection is already initialized");
3468
3469 /* This is what opens the connection and sets x_current_display.
3470 This also initializes many symbols, such as those used for input. */
3471 x_term_init (XSTRING (display)->data);
3472
3473 #ifdef HAVE_X11
3474 XFASTINT (Vwindow_system_version) = 11;
3475
3476 if (!EQ (xrm_string, Qnil))
3477 {
3478 CHECK_STRING (xrm_string, 1);
3479 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
3480 }
3481 else
3482 xrm_option = (unsigned char *) 0;
3483 BLOCK_INPUT;
3484 xrdb = x_load_resources (x_current_display, xrm_option, EMACS_CLASS);
3485 UNBLOCK_INPUT;
3486 #if defined (HAVE_X11R5) || defined (HAVE_XRMSETDATABASE)
3487 XrmSetDatabase (x_current_display, xrdb);
3488 #else
3489 x_current_display->db = xrdb;
3490 #endif
3491
3492 /* Make a version of Vinvocation_name suitable for use in xrdb
3493 queries - i.e. containing no dots or asterisks. */
3494 Vxrdb_name = Fcopy_sequence (Vinvocation_name);
3495 {
3496 int i;
3497 int len = XSTRING (Vxrdb_name)->size;
3498 unsigned char *data = XSTRING (Vxrdb_name)->data;
3499
3500 for (i = 0; i < len; i++)
3501 if (data[i] == '.' || data[i] == '*')
3502 data[i] = '-';
3503 }
3504
3505 x_screen = DefaultScreenOfDisplay (x_current_display);
3506
3507 screen_visual = select_visual (x_screen, &n_planes);
3508 x_screen_planes = n_planes;
3509 x_screen_height = HeightOfScreen (x_screen);
3510 x_screen_width = WidthOfScreen (x_screen);
3511
3512 /* X Atoms used by emacs. */
3513 Xatoms_of_xselect ();
3514 BLOCK_INPUT;
3515 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
3516 False);
3517 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
3518 False);
3519 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
3520 False);
3521 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
3522 False);
3523 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
3524 False);
3525 Xatom_wm_configure_denied = XInternAtom (x_current_display,
3526 "WM_CONFIGURE_DENIED", False);
3527 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
3528 False);
3529 UNBLOCK_INPUT;
3530 #else /* not HAVE_X11 */
3531 XFASTINT (Vwindow_system_version) = 10;
3532 #endif /* not HAVE_X11 */
3533 return Qnil;
3534 }
3535
3536 DEFUN ("x-close-current-connection", Fx_close_current_connection,
3537 Sx_close_current_connection,
3538 0, 0, 0, "Close the connection to the current X server.")
3539 ()
3540 {
3541 #ifdef HAVE_X11
3542 /* This is ONLY used when killing emacs; For switching displays
3543 we'll have to take care of setting CloseDownMode elsewhere. */
3544
3545 if (x_current_display)
3546 {
3547 BLOCK_INPUT;
3548 XSetCloseDownMode (x_current_display, DestroyAll);
3549 XCloseDisplay (x_current_display);
3550 x_current_display = 0;
3551 }
3552 else
3553 fatal ("No current X display connection to close\n");
3554 #endif
3555 return Qnil;
3556 }
3557
3558 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
3559 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
3560 If ON is nil, allow buffering of requests.\n\
3561 Turning on synchronization prohibits the Xlib routines from buffering\n\
3562 requests and seriously degrades performance, but makes debugging much\n\
3563 easier.")
3564 (on)
3565 Lisp_Object on;
3566 {
3567 check_x ();
3568
3569 XSynchronize (x_current_display, !EQ (on, Qnil));
3570
3571 return Qnil;
3572 }
3573
3574 \f
3575 syms_of_xfns ()
3576 {
3577 /* This is zero if not using X windows. */
3578 x_current_display = 0;
3579
3580 /* The section below is built by the lisp expression at the top of the file,
3581 just above where these variables are declared. */
3582 /*&&& init symbols here &&&*/
3583 Qauto_raise = intern ("auto-raise");
3584 staticpro (&Qauto_raise);
3585 Qauto_lower = intern ("auto-lower");
3586 staticpro (&Qauto_lower);
3587 Qbackground_color = intern ("background-color");
3588 staticpro (&Qbackground_color);
3589 Qbar = intern ("bar");
3590 staticpro (&Qbar);
3591 Qborder_color = intern ("border-color");
3592 staticpro (&Qborder_color);
3593 Qborder_width = intern ("border-width");
3594 staticpro (&Qborder_width);
3595 Qbox = intern ("box");
3596 staticpro (&Qbox);
3597 Qcursor_color = intern ("cursor-color");
3598 staticpro (&Qcursor_color);
3599 Qcursor_type = intern ("cursor-type");
3600 staticpro (&Qcursor_type);
3601 Qfont = intern ("font");
3602 staticpro (&Qfont);
3603 Qforeground_color = intern ("foreground-color");
3604 staticpro (&Qforeground_color);
3605 Qgeometry = intern ("geometry");
3606 staticpro (&Qgeometry);
3607 Qicon_left = intern ("icon-left");
3608 staticpro (&Qicon_left);
3609 Qicon_top = intern ("icon-top");
3610 staticpro (&Qicon_top);
3611 Qicon_type = intern ("icon-type");
3612 staticpro (&Qicon_type);
3613 Qinternal_border_width = intern ("internal-border-width");
3614 staticpro (&Qinternal_border_width);
3615 Qleft = intern ("left");
3616 staticpro (&Qleft);
3617 Qmouse_color = intern ("mouse-color");
3618 staticpro (&Qmouse_color);
3619 Qnone = intern ("none");
3620 staticpro (&Qnone);
3621 Qparent_id = intern ("parent-id");
3622 staticpro (&Qparent_id);
3623 Qsuppress_icon = intern ("suppress-icon");
3624 staticpro (&Qsuppress_icon);
3625 Qtop = intern ("top");
3626 staticpro (&Qtop);
3627 Qundefined_color = intern ("undefined-color");
3628 staticpro (&Qundefined_color);
3629 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
3630 staticpro (&Qvertical_scroll_bars);
3631 Qvisibility = intern ("visibility");
3632 staticpro (&Qvisibility);
3633 Qwindow_id = intern ("window-id");
3634 staticpro (&Qwindow_id);
3635 Qx_frame_parameter = intern ("x-frame-parameter");
3636 staticpro (&Qx_frame_parameter);
3637 /* This is the end of symbol initialization. */
3638
3639 Fput (Qundefined_color, Qerror_conditions,
3640 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
3641 Fput (Qundefined_color, Qerror_message,
3642 build_string ("Undefined color"));
3643
3644 init_x_parm_symbols ();
3645
3646 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
3647 "The buffer offset of the character under the pointer.");
3648 mouse_buffer_offset = 0;
3649
3650 DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape,
3651 "The shape of the pointer when over text.\n\
3652 Changing the value does not affect existing frames\n\
3653 unless you set the mouse color.");
3654 Vx_pointer_shape = Qnil;
3655
3656 staticpro (&Vxrdb_name);
3657
3658 #if 0
3659 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
3660 "The shape of the pointer when not over text.");
3661 #endif
3662 Vx_nontext_pointer_shape = Qnil;
3663
3664 #if 0
3665 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
3666 "The shape of the pointer when over the mode line.");
3667 #endif
3668 Vx_mode_pointer_shape = Qnil;
3669
3670 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
3671 "A string indicating the foreground color of the cursor box.");
3672 Vx_cursor_fore_pixel = Qnil;
3673
3674 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
3675 "Non-nil if a mouse button is currently depressed.");
3676 Vmouse_depressed = Qnil;
3677
3678 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
3679 "t if no X window manager is in use.");
3680
3681 #ifdef HAVE_X11
3682 defsubr (&Sx_get_resource);
3683 #if 0
3684 defsubr (&Sx_draw_rectangle);
3685 defsubr (&Sx_erase_rectangle);
3686 defsubr (&Sx_contour_region);
3687 defsubr (&Sx_uncontour_region);
3688 #endif
3689 defsubr (&Sx_display_color_p);
3690 defsubr (&Sx_list_fonts);
3691 defsubr (&Sx_color_defined_p);
3692 defsubr (&Sx_server_vendor);
3693 defsubr (&Sx_server_version);
3694 defsubr (&Sx_display_pixel_width);
3695 defsubr (&Sx_display_pixel_height);
3696 defsubr (&Sx_display_mm_width);
3697 defsubr (&Sx_display_mm_height);
3698 defsubr (&Sx_display_screens);
3699 defsubr (&Sx_display_planes);
3700 defsubr (&Sx_display_color_cells);
3701 defsubr (&Sx_display_visual_class);
3702 defsubr (&Sx_display_backing_store);
3703 defsubr (&Sx_display_save_under);
3704 defsubr (&Sx_rebind_key);
3705 defsubr (&Sx_rebind_keys);
3706 #if 0
3707 defsubr (&Sx_track_pointer);
3708 defsubr (&Sx_grab_pointer);
3709 defsubr (&Sx_ungrab_pointer);
3710 #endif
3711 #else
3712 defsubr (&Sx_get_default);
3713 defsubr (&Sx_store_cut_buffer);
3714 defsubr (&Sx_get_cut_buffer);
3715 #endif
3716 defsubr (&Sx_parse_geometry);
3717 defsubr (&Sx_create_frame);
3718 defsubr (&Sfocus_frame);
3719 defsubr (&Sunfocus_frame);
3720 #if 0
3721 defsubr (&Sx_horizontal_line);
3722 #endif
3723 defsubr (&Sx_open_connection);
3724 defsubr (&Sx_close_current_connection);
3725 defsubr (&Sx_synchronize);
3726 }
3727
3728 #endif /* HAVE_X_WINDOWS */