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