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