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