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