]> code.delx.au - gnu-emacs/blob - src/xfns.c
(Fx_create_frame): Rename menuBarLines resource to menuBar.
[gnu-emacs] / 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 (XTYPE (param_index) == Lisp_Int
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 (XTYPE (value) == Lisp_Int)
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 (XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
1392 {
1393 int wid = FONT_WIDTH (f->display.x->font);
1394 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
1395 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
1396 if (FRAME_X_WINDOW (f))
1397 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1398 }
1399 }
1400 \f
1401 /* Subroutines of creating an X frame. */
1402
1403 /* Make sure that Vx_resource_name is set to a reasonable value. */
1404 static void
1405 validate_x_resource_name ()
1406 {
1407 if (STRINGP (Vx_resource_name))
1408 {
1409 int len = XSTRING (Vx_resource_name)->size;
1410 unsigned char *p = XSTRING (Vx_resource_name)->data;
1411 int i;
1412
1413 /* Allow only letters, digits, - and _,
1414 because those are all that X allows. */
1415 for (i = 0; i < len; i++)
1416 {
1417 int c = p[i];
1418 if (! ((c >= 'a' && c <= 'z')
1419 || (c >= 'A' && c <= 'Z')
1420 || (c >= '0' && c <= '9')
1421 || c == '-' || c == '_'))
1422 goto fail;
1423 }
1424 }
1425 else
1426 fail:
1427 Vx_resource_name = make_string ("emacs", 5);
1428 }
1429
1430
1431 extern char *x_get_string_resource ();
1432 extern XrmDatabase x_load_resources ();
1433
1434 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1435 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1436 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1437 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1438 the name specified by the `-name' or `-rn' command-line arguments.\n\
1439 \n\
1440 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1441 class, respectively. You must specify both of them or neither.\n\
1442 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
1443 and the class is `Emacs.CLASS.SUBCLASS'.")
1444 (attribute, class, component, subclass)
1445 Lisp_Object attribute, class, component, subclass;
1446 {
1447 register char *value;
1448 char *name_key;
1449 char *class_key;
1450 Lisp_Object resname;
1451
1452 check_x ();
1453
1454 CHECK_STRING (attribute, 0);
1455 CHECK_STRING (class, 0);
1456
1457 if (!NILP (component))
1458 CHECK_STRING (component, 1);
1459 if (!NILP (subclass))
1460 CHECK_STRING (subclass, 2);
1461 if (NILP (component) != NILP (subclass))
1462 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1463
1464 validate_x_resource_name ();
1465 resname = Vx_resource_name;
1466
1467 if (NILP (component))
1468 {
1469 /* Allocate space for the components, the dots which separate them,
1470 and the final '\0'. */
1471 name_key = (char *) alloca (XSTRING (resname)->size
1472 + XSTRING (attribute)->size
1473 + 2);
1474 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1475 + XSTRING (class)->size
1476 + 2);
1477
1478 sprintf (name_key, "%s.%s",
1479 XSTRING (resname)->data,
1480 XSTRING (attribute)->data);
1481 sprintf (class_key, "%s.%s",
1482 EMACS_CLASS,
1483 XSTRING (class)->data);
1484 }
1485 else
1486 {
1487 name_key = (char *) alloca (XSTRING (resname)->size
1488 + XSTRING (component)->size
1489 + XSTRING (attribute)->size
1490 + 3);
1491
1492 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1493 + XSTRING (class)->size
1494 + XSTRING (subclass)->size
1495 + 3);
1496
1497 sprintf (name_key, "%s.%s.%s",
1498 XSTRING (resname)->data,
1499 XSTRING (component)->data,
1500 XSTRING (attribute)->data);
1501 sprintf (class_key, "%s.%s.%s",
1502 EMACS_CLASS,
1503 XSTRING (class)->data,
1504 XSTRING (subclass)->data);
1505 }
1506
1507 value = x_get_string_resource (xrdb, name_key, class_key);
1508
1509 if (value != (char *) 0)
1510 return build_string (value);
1511 else
1512 return Qnil;
1513 }
1514
1515 /* Used when C code wants a resource value. */
1516
1517 char *
1518 x_get_resource_string (attribute, class)
1519 char *attribute, *class;
1520 {
1521 register char *value;
1522 char *name_key;
1523 char *class_key;
1524
1525 /* Allocate space for the components, the dots which separate them,
1526 and the final '\0'. */
1527 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1528 + strlen (attribute) + 2);
1529 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1530 + strlen (class) + 2);
1531
1532 sprintf (name_key, "%s.%s",
1533 XSTRING (Vinvocation_name)->data,
1534 attribute);
1535 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
1536
1537 return x_get_string_resource (xrdb, name_key, class_key);
1538 }
1539
1540 /* Types we might convert a resource string into. */
1541 enum resource_types
1542 {
1543 number, boolean, string, symbol
1544 };
1545
1546 /* Return the value of parameter PARAM.
1547
1548 First search ALIST, then Vdefault_frame_alist, then the X defaults
1549 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1550
1551 Convert the resource to the type specified by desired_type.
1552
1553 If no default is specified, return Qunbound. If you call
1554 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1555 and don't let it get stored in any lisp-visible variables! */
1556
1557 static Lisp_Object
1558 x_get_arg (alist, param, attribute, class, type)
1559 Lisp_Object alist, param;
1560 char *attribute;
1561 char *class;
1562 enum resource_types type;
1563 {
1564 register Lisp_Object tem;
1565
1566 tem = Fassq (param, alist);
1567 if (EQ (tem, Qnil))
1568 tem = Fassq (param, Vdefault_frame_alist);
1569 if (EQ (tem, Qnil))
1570 {
1571
1572 if (attribute)
1573 {
1574 tem = Fx_get_resource (build_string (attribute),
1575 build_string (class),
1576 Qnil, Qnil);
1577
1578 if (NILP (tem))
1579 return Qunbound;
1580
1581 switch (type)
1582 {
1583 case number:
1584 return make_number (atoi (XSTRING (tem)->data));
1585
1586 case boolean:
1587 tem = Fdowncase (tem);
1588 if (!strcmp (XSTRING (tem)->data, "on")
1589 || !strcmp (XSTRING (tem)->data, "true"))
1590 return Qt;
1591 else
1592 return Qnil;
1593
1594 case string:
1595 return tem;
1596
1597 case symbol:
1598 /* As a special case, we map the values `true' and `on'
1599 to Qt, and `false' and `off' to Qnil. */
1600 {
1601 Lisp_Object lower;
1602 lower = Fdowncase (tem);
1603 if (!strcmp (XSTRING (lower)->data, "on")
1604 || !strcmp (XSTRING (lower)->data, "true"))
1605 return Qt;
1606 else if (!strcmp (XSTRING (lower)->data, "off")
1607 || !strcmp (XSTRING (lower)->data, "false"))
1608 return Qnil;
1609 else
1610 return Fintern (tem, Qnil);
1611 }
1612
1613 default:
1614 abort ();
1615 }
1616 }
1617 else
1618 return Qunbound;
1619 }
1620 return Fcdr (tem);
1621 }
1622
1623 /* Record in frame F the specified or default value according to ALIST
1624 of the parameter named PARAM (a Lisp symbol).
1625 If no value is specified for PARAM, look for an X default for XPROP
1626 on the frame named NAME.
1627 If that is not found either, use the value DEFLT. */
1628
1629 static Lisp_Object
1630 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
1631 struct frame *f;
1632 Lisp_Object alist;
1633 Lisp_Object prop;
1634 Lisp_Object deflt;
1635 char *xprop;
1636 char *xclass;
1637 enum resource_types type;
1638 {
1639 Lisp_Object tem;
1640
1641 tem = x_get_arg (alist, prop, xprop, xclass, type);
1642 if (EQ (tem, Qunbound))
1643 tem = deflt;
1644 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1645 return tem;
1646 }
1647 \f
1648 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
1649 "Parse an X-style geometry string STRING.\n\
1650 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
1651 The properties returned may include `top', `left', `height', and `width'.\n\
1652 The value of `left' or `top' may be an integer,\n\
1653 or a list (+ N) meaning N pixels relative to top/left corner,\n\
1654 or a list (- N) meaning -N pixels relative to bottom/right corner.")
1655 (string)
1656 Lisp_Object string;
1657 {
1658 int geometry, x, y;
1659 unsigned int width, height;
1660 Lisp_Object result;
1661
1662 CHECK_STRING (string, 0);
1663
1664 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1665 &x, &y, &width, &height);
1666
1667 #if 0
1668 if (!!(geometry & XValue) != !!(geometry & YValue))
1669 error ("Must specify both x and y position, or neither");
1670 #endif
1671
1672 result = Qnil;
1673 if (geometry & XValue)
1674 {
1675 Lisp_Object element;
1676
1677 if (x >= 0 && (geometry & XNegative))
1678 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
1679 else if (x < 0 && ! (geometry & XNegative))
1680 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
1681 else
1682 element = Fcons (Qleft, make_number (x));
1683 result = Fcons (element, result);
1684 }
1685
1686 if (geometry & YValue)
1687 {
1688 Lisp_Object element;
1689
1690 if (y >= 0 && (geometry & YNegative))
1691 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
1692 else if (y < 0 && ! (geometry & YNegative))
1693 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
1694 else
1695 element = Fcons (Qtop, make_number (y));
1696 result = Fcons (element, result);
1697 }
1698
1699 if (geometry & WidthValue)
1700 result = Fcons (Fcons (Qwidth, make_number (width)), result);
1701 if (geometry & HeightValue)
1702 result = Fcons (Fcons (Qheight, make_number (height)), result);
1703
1704 return result;
1705 }
1706
1707 /* Calculate the desired size and position of this window,
1708 and return the flags saying which aspects were specified.
1709
1710 This function does not make the coordinates positive. */
1711
1712 #define DEFAULT_ROWS 40
1713 #define DEFAULT_COLS 80
1714
1715 static int
1716 x_figure_window_size (f, parms)
1717 struct frame *f;
1718 Lisp_Object parms;
1719 {
1720 register Lisp_Object tem0, tem1, tem2;
1721 int height, width, left, top;
1722 register int geometry;
1723 long window_prompting = 0;
1724
1725 /* Default values if we fall through.
1726 Actually, if that happens we should get
1727 window manager prompting. */
1728 f->width = DEFAULT_COLS;
1729 f->height = DEFAULT_ROWS;
1730 /* Window managers expect that if program-specified
1731 positions are not (0,0), they're intentional, not defaults. */
1732 f->display.x->top_pos = 0;
1733 f->display.x->left_pos = 0;
1734
1735 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
1736 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
1737 tem2 = x_get_arg (parms, Quser_size, 0, 0, number);
1738 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1739 {
1740 if (!EQ (tem0, Qunbound))
1741 {
1742 CHECK_NUMBER (tem0, 0);
1743 f->height = XINT (tem0);
1744 }
1745 if (!EQ (tem1, Qunbound))
1746 {
1747 CHECK_NUMBER (tem1, 0);
1748 f->width = XINT (tem1);
1749 }
1750 if (!NILP (tem2) && !EQ (tem2, Qunbound))
1751 window_prompting |= USSize;
1752 else
1753 window_prompting |= PSize;
1754 }
1755
1756 f->display.x->vertical_scroll_bar_extra
1757 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1758 ? FRAME_SCROLL_BAR_PIXEL_WIDTH (f)
1759 : 0);
1760 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
1761 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
1762
1763 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
1764 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
1765 tem2 = x_get_arg (parms, Quser_position, 0, 0, number);
1766 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1767 {
1768 if (EQ (tem0, Qminus))
1769 {
1770 f->display.x->top_pos = 0;
1771 window_prompting |= YNegative;
1772 }
1773 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qminus)
1774 && CONSP (XCONS (tem0)->cdr)
1775 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
1776 {
1777 f->display.x->top_pos = - XINT (XCONS (XCONS (tem0)->cdr)->car);
1778 window_prompting |= YNegative;
1779 }
1780 else if (CONSP (tem0) && EQ (XCONS (tem0)->car, Qplus)
1781 && CONSP (XCONS (tem0)->cdr)
1782 && INTEGERP (XCONS (XCONS (tem0)->cdr)->car))
1783 {
1784 f->display.x->top_pos = XINT (XCONS (XCONS (tem0)->cdr)->car);
1785 }
1786 else if (EQ (tem0, Qunbound))
1787 f->display.x->top_pos = 0;
1788 else
1789 {
1790 CHECK_NUMBER (tem0, 0);
1791 f->display.x->top_pos = XINT (tem0);
1792 if (f->display.x->top_pos < 0)
1793 window_prompting |= YNegative;
1794 }
1795
1796 if (EQ (tem1, Qminus))
1797 {
1798 f->display.x->left_pos = 0;
1799 window_prompting |= XNegative;
1800 }
1801 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qminus)
1802 && CONSP (XCONS (tem1)->cdr)
1803 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
1804 {
1805 f->display.x->left_pos = - XINT (XCONS (XCONS (tem1)->cdr)->car);
1806 window_prompting |= XNegative;
1807 }
1808 else if (CONSP (tem1) && EQ (XCONS (tem1)->car, Qplus)
1809 && CONSP (XCONS (tem1)->cdr)
1810 && INTEGERP (XCONS (XCONS (tem1)->cdr)->car))
1811 {
1812 f->display.x->left_pos = XINT (XCONS (XCONS (tem1)->cdr)->car);
1813 }
1814 else if (EQ (tem1, Qunbound))
1815 f->display.x->left_pos = 0;
1816 else
1817 {
1818 CHECK_NUMBER (tem1, 0);
1819 f->display.x->left_pos = XINT (tem1);
1820 if (f->display.x->left_pos < 0)
1821 window_prompting |= XNegative;
1822 }
1823
1824 if (!NILP (tem2))
1825 window_prompting |= USPosition;
1826 else
1827 window_prompting |= PPosition;
1828 }
1829
1830 return window_prompting;
1831 }
1832
1833 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1834
1835 Status
1836 XSetWMProtocols (dpy, w, protocols, count)
1837 Display *dpy;
1838 Window w;
1839 Atom *protocols;
1840 int count;
1841 {
1842 Atom prop;
1843 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
1844 if (prop == None) return False;
1845 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
1846 (unsigned char *) protocols, count);
1847 return True;
1848 }
1849 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
1850 \f
1851 #ifdef USE_X_TOOLKIT
1852
1853 /* WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
1854 already be present because of the toolkit (Motif adds some of them,
1855 for example, but Xt doesn't). */
1856
1857 static void
1858 hack_wm_protocols (widget)
1859 Widget widget;
1860 {
1861 Display *dpy = XtDisplay (widget);
1862 Window w = XtWindow (widget);
1863 int need_delete = 1;
1864 int need_focus = 1;
1865 int need_save = 1;
1866
1867 BLOCK_INPUT;
1868 {
1869 Atom type, *atoms = 0;
1870 int format = 0;
1871 unsigned long nitems = 0;
1872 unsigned long bytes_after;
1873
1874 if (Success == XGetWindowProperty (dpy, w, Xatom_wm_protocols,
1875 0, 100, False, XA_ATOM,
1876 &type, &format, &nitems, &bytes_after,
1877 (unsigned char **) &atoms)
1878 && format == 32 && type == XA_ATOM)
1879 while (nitems > 0)
1880 {
1881 nitems--;
1882 if (atoms[nitems] == Xatom_wm_delete_window) need_delete = 0;
1883 else if (atoms[nitems] == Xatom_wm_take_focus) need_focus = 0;
1884 else if (atoms[nitems] == Xatom_wm_save_yourself) need_save = 0;
1885 }
1886 if (atoms) XFree ((char *) atoms);
1887 }
1888 {
1889 Atom props [10];
1890 int count = 0;
1891 if (need_delete) props[count++] = Xatom_wm_delete_window;
1892 if (need_focus) props[count++] = Xatom_wm_take_focus;
1893 if (need_save) props[count++] = Xatom_wm_save_yourself;
1894 if (count)
1895 XChangeProperty (dpy, w, Xatom_wm_protocols, XA_ATOM, 32, PropModeAppend,
1896 (unsigned char *) props, count);
1897 }
1898 UNBLOCK_INPUT;
1899 }
1900 #endif
1901 \f
1902 #ifdef USE_X_TOOLKIT
1903
1904 /* Create and set up the X widget for frame F. */
1905
1906 static void
1907 x_window (f, window_prompting, minibuffer_only)
1908 struct frame *f;
1909 long window_prompting;
1910 int minibuffer_only;
1911 {
1912 XClassHint class_hints;
1913 XSetWindowAttributes attributes;
1914 unsigned long attribute_mask;
1915
1916 Widget shell_widget;
1917 Widget pane_widget;
1918 Widget screen_widget;
1919 char* name;
1920 Arg al [25];
1921 int ac;
1922
1923 BLOCK_INPUT;
1924
1925 if (STRINGP (f->name))
1926 name = (char*) XSTRING (f->name)->data;
1927 else
1928 name = "emacs";
1929
1930 ac = 0;
1931 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
1932 XtSetArg (al[ac], XtNinput, 1); ac++;
1933 shell_widget = XtCreatePopupShell ("shell",
1934 topLevelShellWidgetClass,
1935 Xt_app_shell, al, ac);
1936
1937 f->display.x->widget = shell_widget;
1938 /* maybe_set_screen_title_format (shell_widget); */
1939
1940
1941 ac = 0;
1942 XtSetArg (al[ac], XtNborderWidth, 0); ac++;
1943 pane_widget = XtCreateWidget ("pane",
1944 panedWidgetClass,
1945 shell_widget, al, ac);
1946
1947 f->display.x->column_widget = pane_widget;
1948
1949 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
1950 initialize_frame_menubar (f);
1951
1952 /* mappedWhenManaged to false tells to the paned window to not map/unmap
1953 the emacs screen when changing menubar. This reduces flickering. */
1954
1955 ac = 0;
1956 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
1957 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
1958 XtSetArg (al[ac], XtNallowResize, 1); ac++;
1959 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
1960 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
1961 screen_widget = XtCreateWidget (name,
1962 emacsFrameClass,
1963 pane_widget, al, ac);
1964
1965 f->display.x->edit_widget = screen_widget;
1966
1967 if (f->display.x->menubar_widget)
1968 XtManageChild (f->display.x->menubar_widget);
1969 XtManageChild (screen_widget);
1970
1971 /* Do some needed geometry management. */
1972 {
1973 int len;
1974 char *tem, shell_position[32];
1975 Arg al[2];
1976 int ac = 0;
1977 int menubar_size
1978 = (f->display.x->menubar_widget
1979 ? (f->display.x->menubar_widget->core.height
1980 + f->display.x->menubar_widget->core.border_width)
1981 : 0);
1982
1983 if (FRAME_EXTERNAL_MENU_BAR (f))
1984 {
1985 Dimension ibw;
1986 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
1987 menubar_size += ibw;
1988 }
1989
1990 if (window_prompting & USPosition)
1991 {
1992 int left = f->display.x->left_pos;
1993 int xneg = window_prompting & XNegative;
1994 int top = f->display.x->top_pos;
1995 int yneg = window_prompting & YNegative;
1996 if (xneg)
1997 left = -left;
1998 if (yneg)
1999 top = -top;
2000 sprintf (shell_position, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f),
2001 PIXEL_HEIGHT (f) + menubar_size,
2002 (xneg ? '-' : '+'), left,
2003 (yneg ? '-' : '+'), top);
2004 }
2005 else
2006 sprintf (shell_position, "=%dx%d", PIXEL_WIDTH (f),
2007 PIXEL_HEIGHT (f) + menubar_size);
2008 len = strlen (shell_position) + 1;
2009 tem = (char *) xmalloc (len);
2010 strncpy (tem, shell_position, len);
2011 XtSetArg (al[ac], XtNgeometry, tem); ac++;
2012 XtSetValues (shell_widget, al, ac);
2013 }
2014
2015 x_calc_absolute_position (f);
2016
2017 XtManageChild (pane_widget);
2018 XtRealizeWidget (shell_widget);
2019
2020 FRAME_X_WINDOW (f) = XtWindow (screen_widget);
2021
2022 validate_x_resource_name ();
2023 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2024 class_hints.res_class = EMACS_CLASS;
2025 XSetClassHint (x_current_display, XtWindow (shell_widget), &class_hints);
2026
2027 f->display.x->wm_hints.input = True;
2028 f->display.x->wm_hints.flags |= InputHint;
2029 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
2030
2031 hack_wm_protocols (shell_widget);
2032
2033 /* Do a stupid property change to force the server to generate a
2034 propertyNotify event so that the event_stream server timestamp will
2035 be initialized to something relevant to the time we created the window.
2036 */
2037 XChangeProperty (XtDisplay (screen_widget), XtWindow (screen_widget),
2038 Xatom_wm_protocols, XA_ATOM, 32, PropModeAppend,
2039 (unsigned char*) NULL, 0);
2040
2041 /* Make all the standard events reach the Emacs frame. */
2042 attributes.event_mask = STANDARD_EVENT_SET;
2043 attribute_mask = CWEventMask;
2044 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
2045 attribute_mask, &attributes);
2046
2047 XtMapWidget (screen_widget);
2048
2049 /* x_set_name normally ignores requests to set the name if the
2050 requested name is the same as the current name. This is the one
2051 place where that assumption isn't correct; f->name is set, but
2052 the X server hasn't been told. */
2053 {
2054 Lisp_Object name;
2055 int explicit = f->explicit_name;
2056
2057 f->explicit_name = 0;
2058 name = f->name;
2059 f->name = Qnil;
2060 x_set_name (f, name, explicit);
2061 }
2062
2063 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
2064 f->display.x->text_cursor);
2065
2066 UNBLOCK_INPUT;
2067
2068 if (FRAME_X_WINDOW (f) == 0)
2069 error ("Unable to create window");
2070 }
2071
2072 #else /* not USE_X_TOOLKIT */
2073
2074 /* Create and set up the X window for frame F. */
2075
2076 x_window (f)
2077 struct frame *f;
2078
2079 {
2080 XClassHint class_hints;
2081 XSetWindowAttributes attributes;
2082 unsigned long attribute_mask;
2083
2084 attributes.background_pixel = f->display.x->background_pixel;
2085 attributes.border_pixel = f->display.x->border_pixel;
2086 attributes.bit_gravity = StaticGravity;
2087 attributes.backing_store = NotUseful;
2088 attributes.save_under = True;
2089 attributes.event_mask = STANDARD_EVENT_SET;
2090 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
2091 #if 0
2092 | CWBackingStore | CWSaveUnder
2093 #endif
2094 | CWEventMask);
2095
2096 BLOCK_INPUT;
2097 FRAME_X_WINDOW (f)
2098 = XCreateWindow (x_current_display, ROOT_WINDOW,
2099 f->display.x->left_pos,
2100 f->display.x->top_pos,
2101 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
2102 f->display.x->border_width,
2103 CopyFromParent, /* depth */
2104 InputOutput, /* class */
2105 screen_visual, /* set in Fx_open_connection */
2106 attribute_mask, &attributes);
2107
2108 validate_x_resource_name ();
2109 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2110 class_hints.res_class = EMACS_CLASS;
2111 XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
2112
2113 /* This indicates that we use the "Passive Input" input model.
2114 Unless we do this, we don't get the Focus{In,Out} events that we
2115 need to draw the cursor correctly. Accursed bureaucrats.
2116 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
2117
2118 f->display.x->wm_hints.input = True;
2119 f->display.x->wm_hints.flags |= InputHint;
2120 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
2121
2122 /* Request "save yourself" and "delete window" commands from wm. */
2123 {
2124 Atom protocols[2];
2125 protocols[0] = Xatom_wm_delete_window;
2126 protocols[1] = Xatom_wm_save_yourself;
2127 XSetWMProtocols (x_current_display, FRAME_X_WINDOW (f), protocols, 2);
2128 }
2129
2130 /* x_set_name normally ignores requests to set the name if the
2131 requested name is the same as the current name. This is the one
2132 place where that assumption isn't correct; f->name is set, but
2133 the X server hasn't been told. */
2134 {
2135 Lisp_Object name;
2136 int explicit = f->explicit_name;
2137
2138 f->explicit_name = 0;
2139 name = f->name;
2140 f->name = Qnil;
2141 x_set_name (f, name, explicit);
2142 }
2143
2144 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
2145 f->display.x->text_cursor);
2146
2147 UNBLOCK_INPUT;
2148
2149 if (FRAME_X_WINDOW (f) == 0)
2150 error ("Unable to create window");
2151 }
2152
2153 #endif /* not USE_X_TOOLKIT */
2154
2155 /* Handle the icon stuff for this window. Perhaps later we might
2156 want an x_set_icon_position which can be called interactively as
2157 well. */
2158
2159 static void
2160 x_icon (f, parms)
2161 struct frame *f;
2162 Lisp_Object parms;
2163 {
2164 Lisp_Object icon_x, icon_y;
2165
2166 /* Set the position of the icon. Note that twm groups all
2167 icons in an icon window. */
2168 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
2169 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
2170 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2171 {
2172 CHECK_NUMBER (icon_x, 0);
2173 CHECK_NUMBER (icon_y, 0);
2174 }
2175 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2176 error ("Both left and top icon corners of icon must be specified");
2177
2178 BLOCK_INPUT;
2179
2180 if (! EQ (icon_x, Qunbound))
2181 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
2182
2183 /* Start up iconic or window? */
2184 x_wm_set_window_state
2185 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
2186 ? IconicState
2187 : NormalState));
2188
2189 UNBLOCK_INPUT;
2190 }
2191
2192 /* Make the GC's needed for this window, setting the
2193 background, border and mouse colors; also create the
2194 mouse cursor and the gray border tile. */
2195
2196 static char cursor_bits[] =
2197 {
2198 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2199 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2200 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2201 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2202 };
2203
2204 static void
2205 x_make_gc (f)
2206 struct frame *f;
2207 {
2208 XGCValues gc_values;
2209 GC temp_gc;
2210 XImage tileimage;
2211
2212 BLOCK_INPUT;
2213
2214 /* Create the GC's of this frame.
2215 Note that many default values are used. */
2216
2217 /* Normal video */
2218 gc_values.font = f->display.x->font->fid;
2219 gc_values.foreground = f->display.x->foreground_pixel;
2220 gc_values.background = f->display.x->background_pixel;
2221 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
2222 f->display.x->normal_gc = XCreateGC (x_current_display,
2223 FRAME_X_WINDOW (f),
2224 GCLineWidth | GCFont
2225 | GCForeground | GCBackground,
2226 &gc_values);
2227
2228 /* Reverse video style. */
2229 gc_values.foreground = f->display.x->background_pixel;
2230 gc_values.background = f->display.x->foreground_pixel;
2231 f->display.x->reverse_gc = XCreateGC (x_current_display,
2232 FRAME_X_WINDOW (f),
2233 GCFont | GCForeground | GCBackground
2234 | GCLineWidth,
2235 &gc_values);
2236
2237 /* Cursor has cursor-color background, background-color foreground. */
2238 gc_values.foreground = f->display.x->background_pixel;
2239 gc_values.background = f->display.x->cursor_pixel;
2240 gc_values.fill_style = FillOpaqueStippled;
2241 gc_values.stipple
2242 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
2243 cursor_bits, 16, 16);
2244 f->display.x->cursor_gc
2245 = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
2246 (GCFont | GCForeground | GCBackground
2247 | GCFillStyle | GCStipple | GCLineWidth),
2248 &gc_values);
2249
2250 /* Create the gray border tile used when the pointer is not in
2251 the frame. Since this depends on the frame's pixel values,
2252 this must be done on a per-frame basis. */
2253 f->display.x->border_tile
2254 = (XCreatePixmapFromBitmapData
2255 (x_current_display, ROOT_WINDOW,
2256 gray_bits, gray_width, gray_height,
2257 f->display.x->foreground_pixel,
2258 f->display.x->background_pixel,
2259 DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
2260
2261 UNBLOCK_INPUT;
2262 }
2263
2264 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
2265 1, 1, 0,
2266 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2267 Return an Emacs frame object representing the X window.\n\
2268 ALIST is an alist of frame parameters.\n\
2269 If the parameters specify that the frame should not have a minibuffer,\n\
2270 and do not specify a specific minibuffer window to use,\n\
2271 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2272 be shared by the new frame.")
2273 (parms)
2274 Lisp_Object parms;
2275 {
2276 struct frame *f;
2277 Lisp_Object frame, tem;
2278 Lisp_Object name;
2279 int minibuffer_only = 0;
2280 long window_prompting = 0;
2281 int width, height;
2282 int count = specpdl_ptr - specpdl;
2283 struct gcpro gcpro1;
2284
2285 check_x ();
2286
2287 name = x_get_arg (parms, Qname, "title", "Title", string);
2288 if (XTYPE (name) != Lisp_String
2289 && ! EQ (name, Qunbound)
2290 && ! NILP (name))
2291 error ("x-create-frame: name parameter must be a string");
2292
2293 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
2294 if (EQ (tem, Qnone) || NILP (tem))
2295 f = make_frame_without_minibuffer (Qnil);
2296 else if (EQ (tem, Qonly))
2297 {
2298 f = make_minibuffer_frame ();
2299 minibuffer_only = 1;
2300 }
2301 else if (XTYPE (tem) == Lisp_Window)
2302 f = make_frame_without_minibuffer (tem);
2303 else
2304 f = make_frame (1);
2305
2306 /* Note that X Windows does support scroll bars. */
2307 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
2308
2309 /* Set the name; the functions to which we pass f expect the name to
2310 be set. */
2311 if (EQ (name, Qunbound) || NILP (name))
2312 {
2313 f->name = build_string (x_id_name);
2314 f->explicit_name = 0;
2315 }
2316 else
2317 {
2318 f->name = name;
2319 f->explicit_name = 1;
2320 /* use the frame's title when getting resources for this frame. */
2321 specbind (Qx_resource_name, name);
2322 }
2323
2324 XSET (frame, Lisp_Frame, f);
2325 GCPRO1 (frame);
2326
2327 f->output_method = output_x_window;
2328 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
2329 bzero (f->display.x, sizeof (struct x_display));
2330
2331 /* Note that the frame has no physical cursor right now. */
2332 f->phys_cursor_x = -1;
2333
2334 /* Extract the window parameters from the supplied values
2335 that are needed to determine window geometry. */
2336 {
2337 Lisp_Object font;
2338
2339 font = x_get_arg (parms, Qfont, "font", "Font", string);
2340 BLOCK_INPUT;
2341 /* First, try whatever font the caller has specified. */
2342 if (STRINGP (font))
2343 font = x_new_font (f, XSTRING (font)->data);
2344 /* Try out a font which we hope has bold and italic variations. */
2345 if (!STRINGP (font))
2346 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
2347 if (! STRINGP (font))
2348 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
2349 if (! STRINGP (font))
2350 /* This was formerly the first thing tried, but it finds too many fonts
2351 and takes too long. */
2352 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2353 /* If those didn't work, look for something which will at least work. */
2354 if (! STRINGP (font))
2355 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
2356 UNBLOCK_INPUT;
2357 if (! STRINGP (font))
2358 font = build_string ("fixed");
2359
2360 x_default_parameter (f, parms, Qfont, font,
2361 "font", "Font", string);
2362 }
2363
2364 x_default_parameter (f, parms, Qborder_width, make_number (2),
2365 "borderwidth", "BorderWidth", number);
2366 /* This defaults to 2 in order to match xterm. We recognize either
2367 internalBorderWidth or internalBorder (which is what xterm calls
2368 it). */
2369 if (NILP (Fassq (Qinternal_border_width, parms)))
2370 {
2371 Lisp_Object value;
2372
2373 value = x_get_arg (parms, Qinternal_border_width,
2374 "internalBorder", "BorderWidth", number);
2375 if (! EQ (value, Qunbound))
2376 parms = Fcons (Fcons (Qinternal_border_width, value),
2377 parms);
2378 }
2379 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
2380 "internalBorderWidth", "BorderWidth", number);
2381 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
2382 "verticalScrollBars", "ScrollBars", boolean);
2383
2384 /* Also do the stuff which must be set before the window exists. */
2385 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
2386 "foreground", "Foreground", string);
2387 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
2388 "background", "Background", string);
2389 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
2390 "pointerColor", "Foreground", string);
2391 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
2392 "cursorColor", "Foreground", string);
2393 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
2394 "borderColor", "BorderColor", string);
2395
2396 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
2397 "menuBar", "MenuBar", number);
2398 x_default_parameter (f, parms, Qscroll_bar_width, make_number (12),
2399 "scrollBarWidth", "ScrollBarWidth", number);
2400
2401 f->display.x->parent_desc = ROOT_WINDOW;
2402 window_prompting = x_figure_window_size (f, parms);
2403
2404 if (window_prompting & XNegative)
2405 {
2406 if (window_prompting & YNegative)
2407 f->display.x->win_gravity = SouthEastGravity;
2408 else
2409 f->display.x->win_gravity = NorthEastGravity;
2410 }
2411 else
2412 {
2413 if (window_prompting & YNegative)
2414 f->display.x->win_gravity = SouthWestGravity;
2415 else
2416 f->display.x->win_gravity = NorthWestGravity;
2417 }
2418
2419 f->display.x->size_hint_flags = window_prompting;
2420
2421 #ifdef USE_X_TOOLKIT
2422 x_window (f, window_prompting, minibuffer_only);
2423 #else
2424 x_window (f);
2425 #endif
2426 x_icon (f, parms);
2427 x_make_gc (f);
2428 init_frame_faces (f);
2429
2430 /* We need to do this after creating the X window, so that the
2431 icon-creation functions can say whose icon they're describing. */
2432 x_default_parameter (f, parms, Qicon_type, Qnil,
2433 "bitmapIcon", "BitmapIcon", symbol);
2434
2435 x_default_parameter (f, parms, Qauto_raise, Qnil,
2436 "autoRaise", "AutoRaiseLower", boolean);
2437 x_default_parameter (f, parms, Qauto_lower, Qnil,
2438 "autoLower", "AutoRaiseLower", boolean);
2439 x_default_parameter (f, parms, Qcursor_type, Qbox,
2440 "cursorType", "CursorType", symbol);
2441
2442 /* Dimensions, especially f->height, must be done via change_frame_size.
2443 Change will not be effected unless different from the current
2444 f->height. */
2445 width = f->width;
2446 height = f->height;
2447 f->height = f->width = 0;
2448 change_frame_size (f, height, width, 1, 0);
2449
2450 /* With the toolkit, the geometry management is done in x_window. */
2451 #ifndef USE_X_TOOLKIT
2452 BLOCK_INPUT;
2453 x_wm_set_size_hint (f, window_prompting, 0);
2454 UNBLOCK_INPUT;
2455 #endif /* USE_X_TOOLKIT */
2456
2457 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2458 f->no_split = minibuffer_only || EQ (tem, Qt);
2459
2460 FRAME_X_SCREEN (f) = &the_x_screen;
2461 FRAME_X_SCREEN (f)->reference_count++;
2462 the_x_screen.x_display_value = x_current_display;
2463
2464 UNGCPRO;
2465
2466 /* It is now ok to make the frame official
2467 even if we get an error below.
2468 And the frame needs to be on Vframe_list
2469 or making it visible won't work. */
2470 Vframe_list = Fcons (frame, Vframe_list);
2471
2472 /* Make the window appear on the frame and enable display,
2473 unless the caller says not to. */
2474 {
2475 Lisp_Object visibility;
2476
2477 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2478 if (EQ (visibility, Qunbound))
2479 visibility = Qt;
2480
2481 if (EQ (visibility, Qicon))
2482 x_iconify_frame (f);
2483 else if (! NILP (visibility))
2484 x_make_frame_visible (f);
2485 else
2486 /* Must have been Qnil. */
2487 ;
2488 }
2489
2490 return unbind_to (count, frame);
2491 }
2492
2493 Lisp_Object
2494 x_get_focus_frame ()
2495 {
2496 Lisp_Object xfocus;
2497 if (! x_focus_frame)
2498 return Qnil;
2499
2500 XSET (xfocus, Lisp_Frame, x_focus_frame);
2501 return xfocus;
2502 }
2503
2504 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2505 "Set the focus on FRAME.")
2506 (frame)
2507 Lisp_Object frame;
2508 {
2509 CHECK_LIVE_FRAME (frame, 0);
2510
2511 if (FRAME_X_P (XFRAME (frame)))
2512 {
2513 BLOCK_INPUT;
2514 x_focus_on_frame (XFRAME (frame));
2515 UNBLOCK_INPUT;
2516 return frame;
2517 }
2518
2519 return Qnil;
2520 }
2521
2522 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2523 "If a frame has been focused, release it.")
2524 ()
2525 {
2526 if (x_focus_frame)
2527 {
2528 BLOCK_INPUT;
2529 x_unfocus_frame (x_focus_frame);
2530 UNBLOCK_INPUT;
2531 }
2532
2533 return Qnil;
2534 }
2535 \f
2536 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
2537 "Return a list of the names of available fonts matching PATTERN.\n\
2538 If optional arguments FACE and FRAME are specified, return only fonts\n\
2539 the same size as FACE on FRAME.\n\
2540 \n\
2541 PATTERN is a string, perhaps with wildcard characters;\n\
2542 the * character matches any substring, and\n\
2543 the ? character matches any single character.\n\
2544 PATTERN is case-insensitive.\n\
2545 FACE is a face name - a symbol.\n\
2546 \n\
2547 The return value is a list of strings, suitable as arguments to\n\
2548 set-face-font.\n\
2549 \n\
2550 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2551 even if they match PATTERN and FACE.")
2552 (pattern, face, frame)
2553 Lisp_Object pattern, face, frame;
2554 {
2555 int num_fonts;
2556 char **names;
2557 XFontStruct *info;
2558 XFontStruct *size_ref;
2559 Lisp_Object list;
2560 FRAME_PTR f;
2561
2562 check_x ();
2563 CHECK_STRING (pattern, 0);
2564 if (!NILP (face))
2565 CHECK_SYMBOL (face, 1);
2566 if (!NILP (frame))
2567 CHECK_LIVE_FRAME (frame, 2);
2568
2569 f = NILP (frame) ? selected_frame : XFRAME (frame);
2570
2571 /* Determine the width standard for comparison with the fonts we find. */
2572
2573 if (NILP (face))
2574 size_ref = 0;
2575 else
2576 {
2577 int face_id;
2578
2579 /* Don't die if we get called with a terminal frame. */
2580 if (! FRAME_X_P (f))
2581 error ("non-X frame used in `x-list-fonts'");
2582
2583 face_id = face_name_id_number (f, face);
2584
2585 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
2586 || FRAME_PARAM_FACES (f) [face_id] == 0)
2587 size_ref = f->display.x->font;
2588 else
2589 {
2590 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
2591 if (size_ref == (XFontStruct *) (~0))
2592 size_ref = f->display.x->font;
2593 }
2594 }
2595
2596 /* See if we cached the result for this particular query. */
2597 list = Fassoc (pattern, FRAME_X_SCREEN (f)->font_list_cache);
2598
2599 /* We have info in the cache for this PATTERN. */
2600 if (!NILP (list))
2601 {
2602 Lisp_Object tem, newlist;
2603
2604 /* We have info about this pattern. */
2605 list = XCONS (list)->cdr;
2606
2607 if (size_ref == 0)
2608 return list;
2609
2610 BLOCK_INPUT;
2611
2612 /* Filter the cached info and return just the fonts that match FACE. */
2613 newlist = Qnil;
2614 for (tem = list; CONSP (tem); tem = XCONS (tem)->cdr)
2615 {
2616 XFontStruct *thisinfo;
2617
2618 thisinfo = XLoadQueryFont (x_current_display,
2619 XSTRING (XCONS (tem)->car)->data);
2620
2621 if (thisinfo && same_size_fonts (thisinfo, size_ref))
2622 newlist = Fcons (XCONS (tem)->car, newlist);
2623
2624 XFreeFont (x_current_display, thisinfo);
2625 }
2626
2627 UNBLOCK_INPUT;
2628
2629 return newlist;
2630 }
2631
2632 BLOCK_INPUT;
2633
2634 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2635 #ifdef BROKEN_XLISTFONTSWITHINFO
2636 names = XListFonts (x_current_display,
2637 XSTRING (pattern)->data,
2638 2000, /* maxnames */
2639 &num_fonts); /* count_return */
2640 #else
2641 names = XListFontsWithInfo (x_current_display,
2642 XSTRING (pattern)->data,
2643 2000, /* maxnames */
2644 &num_fonts, /* count_return */
2645 &info); /* info_return */
2646 #endif
2647 UNBLOCK_INPUT;
2648
2649 list = Qnil;
2650
2651 if (names)
2652 {
2653 int i;
2654 Lisp_Object full_list;
2655
2656 /* Make a list of all the fonts we got back.
2657 Store that in the font cache for the display. */
2658 full_list = Qnil;
2659 for (i = 0; i < num_fonts; i++)
2660 full_list = Fcons (build_string (names[i]), full_list);
2661 FRAME_X_SCREEN (f)->font_list_cache
2662 = Fcons (Fcons (pattern, full_list),
2663 FRAME_X_SCREEN (f)->font_list_cache);
2664
2665 /* Make a list of the fonts that have the right width. */
2666 list = Qnil;
2667 for (i = 0; i < num_fonts; i++)
2668 {
2669 XFontStruct *thisinfo;
2670
2671 #ifdef BROKEN_XLISTFONTSWITHINFO
2672 BLOCK_INPUT;
2673 thisinfo = XLoadQueryFont (x_current_display, names[i]);
2674 UNBLOCK_INPUT;
2675 #else
2676 thisinfo = &info[i];
2677 #endif
2678 if (thisinfo && (! size_ref
2679 || same_size_fonts (thisinfo, size_ref)))
2680 list = Fcons (build_string (names[i]), list);
2681 }
2682 list = Fnreverse (list);
2683
2684 BLOCK_INPUT;
2685 #ifdef BROKEN_XLISTFONTSWITHINFO
2686 XFreeFontNames (names);
2687 #else
2688 XFreeFontInfo (names, info, num_fonts);
2689 #endif
2690 UNBLOCK_INPUT;
2691 }
2692
2693 return list;
2694 }
2695
2696 \f
2697 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0,
2698 "Return non-nil if the X display supports the color named COLOR.")
2699 (color)
2700 Lisp_Object color;
2701 {
2702 Color foo;
2703
2704 check_x ();
2705 CHECK_STRING (color, 0);
2706
2707 if (defined_color (XSTRING (color)->data, &foo, 0))
2708 return Qt;
2709 else
2710 return Qnil;
2711 }
2712
2713 DEFUN ("x-color-values", Fx_color_values, Sx_color_values, 1, 1, 0,
2714 "Return a description of the color named COLOR.\n\
2715 The value is a list of integer RGB values--(RED GREEN BLUE).\n\
2716 These values appear to range from 0 to 65280; white is (65280 65280 65280).")
2717 (color)
2718 Lisp_Object color;
2719 {
2720 Color foo;
2721
2722 check_x ();
2723 CHECK_STRING (color, 0);
2724
2725 if (defined_color (XSTRING (color)->data, &foo, 0))
2726 {
2727 Lisp_Object rgb[3];
2728
2729 rgb[0] = make_number (foo.red);
2730 rgb[1] = make_number (foo.green);
2731 rgb[2] = make_number (foo.blue);
2732 return Flist (3, rgb);
2733 }
2734 else
2735 return Qnil;
2736 }
2737
2738 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0,
2739 "Return t if the X screen currently in use supports color.")
2740 ()
2741 {
2742 check_x ();
2743
2744 if (x_screen_planes <= 2)
2745 return Qnil;
2746
2747 switch (screen_visual->class)
2748 {
2749 case StaticColor:
2750 case PseudoColor:
2751 case TrueColor:
2752 case DirectColor:
2753 return Qt;
2754
2755 default:
2756 return Qnil;
2757 }
2758 }
2759
2760 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
2761 0, 0, 0,
2762 "Return t if the X screen currently in use supports grayscale.")
2763 ()
2764 {
2765 check_x ();
2766
2767 return (x_screen_planes > 1
2768 && (screen_visual->class == StaticGray
2769 || screen_visual->class == GrayScale));
2770 }
2771
2772 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2773 0, 1, 0,
2774 "Returns the width in pixels of the display FRAME is on.")
2775 (frame)
2776 Lisp_Object frame;
2777 {
2778 Display *dpy = x_current_display;
2779 check_x ();
2780 return make_number (DisplayWidth (dpy, DefaultScreen (dpy)));
2781 }
2782
2783 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2784 Sx_display_pixel_height, 0, 1, 0,
2785 "Returns the height in pixels of the display FRAME is on.")
2786 (frame)
2787 Lisp_Object frame;
2788 {
2789 Display *dpy = x_current_display;
2790 check_x ();
2791 return make_number (DisplayHeight (dpy, DefaultScreen (dpy)));
2792 }
2793
2794 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2795 0, 1, 0,
2796 "Returns the number of bitplanes of the display FRAME is on.")
2797 (frame)
2798 Lisp_Object frame;
2799 {
2800 Display *dpy = x_current_display;
2801 check_x ();
2802 return make_number (DisplayPlanes (dpy, DefaultScreen (dpy)));
2803 }
2804
2805 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2806 0, 1, 0,
2807 "Returns the number of color cells of the display FRAME is on.")
2808 (frame)
2809 Lisp_Object frame;
2810 {
2811 Display *dpy = x_current_display;
2812 check_x ();
2813 return make_number (DisplayCells (dpy, DefaultScreen (dpy)));
2814 }
2815
2816 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
2817 Sx_server_max_request_size,
2818 0, 1, 0,
2819 "Returns the maximum request size of the X server FRAME is using.")
2820 (frame)
2821 Lisp_Object frame;
2822 {
2823 Display *dpy = x_current_display;
2824 check_x ();
2825 return make_number (MAXREQUEST (dpy));
2826 }
2827
2828 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
2829 "Returns the vendor ID string of the X server FRAME is on.")
2830 (frame)
2831 Lisp_Object frame;
2832 {
2833 Display *dpy = x_current_display;
2834 char *vendor;
2835 check_x ();
2836 vendor = ServerVendor (dpy);
2837 if (! vendor) vendor = "";
2838 return build_string (vendor);
2839 }
2840
2841 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
2842 "Returns the version numbers of the X server in use.\n\
2843 The value is a list of three integers: the major and minor\n\
2844 version numbers of the X Protocol in use, and the vendor-specific release\n\
2845 number. See also the variable `x-server-vendor'.")
2846 (frame)
2847 Lisp_Object frame;
2848 {
2849 Display *dpy = x_current_display;
2850
2851 check_x ();
2852 return Fcons (make_number (ProtocolVersion (dpy)),
2853 Fcons (make_number (ProtocolRevision (dpy)),
2854 Fcons (make_number (VendorRelease (dpy)), Qnil)));
2855 }
2856
2857 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
2858 "Returns the number of screens on the X server FRAME is on.")
2859 (frame)
2860 Lisp_Object frame;
2861 {
2862 check_x ();
2863 return make_number (ScreenCount (x_current_display));
2864 }
2865
2866 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
2867 "Returns the height in millimeters of the X screen FRAME is on.")
2868 (frame)
2869 Lisp_Object frame;
2870 {
2871 check_x ();
2872 return make_number (HeightMMOfScreen (x_screen));
2873 }
2874
2875 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
2876 "Returns the width in millimeters of the X screen FRAME is on.")
2877 (frame)
2878 Lisp_Object frame;
2879 {
2880 check_x ();
2881 return make_number (WidthMMOfScreen (x_screen));
2882 }
2883
2884 DEFUN ("x-display-backing-store", Fx_display_backing_store,
2885 Sx_display_backing_store, 0, 1, 0,
2886 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
2887 The value may be `always', `when-mapped', or `not-useful'.")
2888 (frame)
2889 Lisp_Object frame;
2890 {
2891 check_x ();
2892
2893 switch (DoesBackingStore (x_screen))
2894 {
2895 case Always:
2896 return intern ("always");
2897
2898 case WhenMapped:
2899 return intern ("when-mapped");
2900
2901 case NotUseful:
2902 return intern ("not-useful");
2903
2904 default:
2905 error ("Strange value for BackingStore parameter of screen");
2906 }
2907 }
2908
2909 DEFUN ("x-display-visual-class", Fx_display_visual_class,
2910 Sx_display_visual_class, 0, 1, 0,
2911 "Returns the visual class of the display `screen' is on.\n\
2912 The value is one of the symbols `static-gray', `gray-scale',\n\
2913 `static-color', `pseudo-color', `true-color', or `direct-color'.")
2914 (screen)
2915 Lisp_Object screen;
2916 {
2917 check_x ();
2918
2919 switch (screen_visual->class)
2920 {
2921 case StaticGray: return (intern ("static-gray"));
2922 case GrayScale: return (intern ("gray-scale"));
2923 case StaticColor: return (intern ("static-color"));
2924 case PseudoColor: return (intern ("pseudo-color"));
2925 case TrueColor: return (intern ("true-color"));
2926 case DirectColor: return (intern ("direct-color"));
2927 default:
2928 error ("Display has an unknown visual class");
2929 }
2930 }
2931
2932 DEFUN ("x-display-save-under", Fx_display_save_under,
2933 Sx_display_save_under, 0, 1, 0,
2934 "Returns t if the X screen FRAME is on supports the save-under feature.")
2935 (frame)
2936 Lisp_Object frame;
2937 {
2938 check_x ();
2939
2940 if (DoesSaveUnders (x_screen) == True)
2941 return Qt;
2942 else
2943 return Qnil;
2944 }
2945 \f
2946 x_pixel_width (f)
2947 register struct frame *f;
2948 {
2949 return PIXEL_WIDTH (f);
2950 }
2951
2952 x_pixel_height (f)
2953 register struct frame *f;
2954 {
2955 return PIXEL_HEIGHT (f);
2956 }
2957
2958 x_char_width (f)
2959 register struct frame *f;
2960 {
2961 return FONT_WIDTH (f->display.x->font);
2962 }
2963
2964 x_char_height (f)
2965 register struct frame *f;
2966 {
2967 return f->display.x->line_height;
2968 }
2969 \f
2970 #if 0 /* These no longer seem like the right way to do things. */
2971
2972 /* Draw a rectangle on the frame with left top corner including
2973 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
2974 CHARS by LINES wide and long and is the color of the cursor. */
2975
2976 void
2977 x_rectangle (f, gc, left_char, top_char, chars, lines)
2978 register struct frame *f;
2979 GC gc;
2980 register int top_char, left_char, chars, lines;
2981 {
2982 int width;
2983 int height;
2984 int left = (left_char * FONT_WIDTH (f->display.x->font)
2985 + f->display.x->internal_border_width);
2986 int top = (top_char * f->display.x->line_height
2987 + f->display.x->internal_border_width);
2988
2989 if (chars < 0)
2990 width = FONT_WIDTH (f->display.x->font) / 2;
2991 else
2992 width = FONT_WIDTH (f->display.x->font) * chars;
2993 if (lines < 0)
2994 height = f->display.x->line_height / 2;
2995 else
2996 height = f->display.x->line_height * lines;
2997
2998 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
2999 gc, left, top, width, height);
3000 }
3001
3002 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
3003 "Draw a rectangle on FRAME between coordinates specified by\n\
3004 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3005 (frame, X0, Y0, X1, Y1)
3006 register Lisp_Object frame, X0, X1, Y0, Y1;
3007 {
3008 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3009
3010 CHECK_LIVE_FRAME (frame, 0);
3011 CHECK_NUMBER (X0, 0);
3012 CHECK_NUMBER (Y0, 1);
3013 CHECK_NUMBER (X1, 2);
3014 CHECK_NUMBER (Y1, 3);
3015
3016 x0 = XINT (X0);
3017 x1 = XINT (X1);
3018 y0 = XINT (Y0);
3019 y1 = XINT (Y1);
3020
3021 if (y1 > y0)
3022 {
3023 top = y0;
3024 n_lines = y1 - y0 + 1;
3025 }
3026 else
3027 {
3028 top = y1;
3029 n_lines = y0 - y1 + 1;
3030 }
3031
3032 if (x1 > x0)
3033 {
3034 left = x0;
3035 n_chars = x1 - x0 + 1;
3036 }
3037 else
3038 {
3039 left = x1;
3040 n_chars = x0 - x1 + 1;
3041 }
3042
3043 BLOCK_INPUT;
3044 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
3045 left, top, n_chars, n_lines);
3046 UNBLOCK_INPUT;
3047
3048 return Qt;
3049 }
3050
3051 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
3052 "Draw a rectangle drawn on FRAME between coordinates\n\
3053 X0, Y0, X1, Y1 in the regular background-pixel.")
3054 (frame, X0, Y0, X1, Y1)
3055 register Lisp_Object frame, X0, Y0, X1, Y1;
3056 {
3057 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3058
3059 CHECK_FRAME (frame, 0);
3060 CHECK_NUMBER (X0, 0);
3061 CHECK_NUMBER (Y0, 1);
3062 CHECK_NUMBER (X1, 2);
3063 CHECK_NUMBER (Y1, 3);
3064
3065 x0 = XINT (X0);
3066 x1 = XINT (X1);
3067 y0 = XINT (Y0);
3068 y1 = XINT (Y1);
3069
3070 if (y1 > y0)
3071 {
3072 top = y0;
3073 n_lines = y1 - y0 + 1;
3074 }
3075 else
3076 {
3077 top = y1;
3078 n_lines = y0 - y1 + 1;
3079 }
3080
3081 if (x1 > x0)
3082 {
3083 left = x0;
3084 n_chars = x1 - x0 + 1;
3085 }
3086 else
3087 {
3088 left = x1;
3089 n_chars = x0 - x1 + 1;
3090 }
3091
3092 BLOCK_INPUT;
3093 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
3094 left, top, n_chars, n_lines);
3095 UNBLOCK_INPUT;
3096
3097 return Qt;
3098 }
3099
3100 /* Draw lines around the text region beginning at the character position
3101 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3102 pixel and line characteristics. */
3103
3104 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3105
3106 static void
3107 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
3108 register struct frame *f;
3109 GC gc;
3110 int top_x, top_y, bottom_x, bottom_y;
3111 {
3112 register int ibw = f->display.x->internal_border_width;
3113 register int font_w = FONT_WIDTH (f->display.x->font);
3114 register int font_h = f->display.x->line_height;
3115 int y = top_y;
3116 int x = line_len (y);
3117 XPoint *pixel_points
3118 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
3119 register XPoint *this_point = pixel_points;
3120
3121 /* Do the horizontal top line/lines */
3122 if (top_x == 0)
3123 {
3124 this_point->x = ibw;
3125 this_point->y = ibw + (font_h * top_y);
3126 this_point++;
3127 if (x == 0)
3128 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
3129 else
3130 this_point->x = ibw + (font_w * x);
3131 this_point->y = (this_point - 1)->y;
3132 }
3133 else
3134 {
3135 this_point->x = ibw;
3136 this_point->y = ibw + (font_h * (top_y + 1));
3137 this_point++;
3138 this_point->x = ibw + (font_w * top_x);
3139 this_point->y = (this_point - 1)->y;
3140 this_point++;
3141 this_point->x = (this_point - 1)->x;
3142 this_point->y = ibw + (font_h * top_y);
3143 this_point++;
3144 this_point->x = ibw + (font_w * x);
3145 this_point->y = (this_point - 1)->y;
3146 }
3147
3148 /* Now do the right side. */
3149 while (y < bottom_y)
3150 { /* Right vertical edge */
3151 this_point++;
3152 this_point->x = (this_point - 1)->x;
3153 this_point->y = ibw + (font_h * (y + 1));
3154 this_point++;
3155
3156 y++; /* Horizontal connection to next line */
3157 x = line_len (y);
3158 if (x == 0)
3159 this_point->x = ibw + (font_w / 2);
3160 else
3161 this_point->x = ibw + (font_w * x);
3162
3163 this_point->y = (this_point - 1)->y;
3164 }
3165
3166 /* Now do the bottom and connect to the top left point. */
3167 this_point->x = ibw + (font_w * (bottom_x + 1));
3168
3169 this_point++;
3170 this_point->x = (this_point - 1)->x;
3171 this_point->y = ibw + (font_h * (bottom_y + 1));
3172 this_point++;
3173 this_point->x = ibw;
3174 this_point->y = (this_point - 1)->y;
3175 this_point++;
3176 this_point->x = pixel_points->x;
3177 this_point->y = pixel_points->y;
3178
3179 XDrawLines (x_current_display, FRAME_X_WINDOW (f),
3180 gc, pixel_points,
3181 (this_point - pixel_points + 1), CoordModeOrigin);
3182 }
3183
3184 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
3185 "Highlight the region between point and the character under the mouse\n\
3186 selected frame.")
3187 (event)
3188 register Lisp_Object event;
3189 {
3190 register int x0, y0, x1, y1;
3191 register struct frame *f = selected_frame;
3192 register int p1, p2;
3193
3194 CHECK_CONS (event, 0);
3195
3196 BLOCK_INPUT;
3197 x0 = XINT (Fcar (Fcar (event)));
3198 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3199
3200 /* If the mouse is past the end of the line, don't that area. */
3201 /* ReWrite this... */
3202
3203 x1 = f->cursor_x;
3204 y1 = f->cursor_y;
3205
3206 if (y1 > y0) /* point below mouse */
3207 outline_region (f, f->display.x->cursor_gc,
3208 x0, y0, x1, y1);
3209 else if (y1 < y0) /* point above mouse */
3210 outline_region (f, f->display.x->cursor_gc,
3211 x1, y1, x0, y0);
3212 else /* same line: draw horizontal rectangle */
3213 {
3214 if (x1 > x0)
3215 x_rectangle (f, f->display.x->cursor_gc,
3216 x0, y0, (x1 - x0 + 1), 1);
3217 else if (x1 < x0)
3218 x_rectangle (f, f->display.x->cursor_gc,
3219 x1, y1, (x0 - x1 + 1), 1);
3220 }
3221
3222 XFlush (x_current_display);
3223 UNBLOCK_INPUT;
3224
3225 return Qnil;
3226 }
3227
3228 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
3229 "Erase any highlighting of the region between point and the character\n\
3230 at X, Y on the selected frame.")
3231 (event)
3232 register Lisp_Object event;
3233 {
3234 register int x0, y0, x1, y1;
3235 register struct frame *f = selected_frame;
3236
3237 BLOCK_INPUT;
3238 x0 = XINT (Fcar (Fcar (event)));
3239 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3240 x1 = f->cursor_x;
3241 y1 = f->cursor_y;
3242
3243 if (y1 > y0) /* point below mouse */
3244 outline_region (f, f->display.x->reverse_gc,
3245 x0, y0, x1, y1);
3246 else if (y1 < y0) /* point above mouse */
3247 outline_region (f, f->display.x->reverse_gc,
3248 x1, y1, x0, y0);
3249 else /* same line: draw horizontal rectangle */
3250 {
3251 if (x1 > x0)
3252 x_rectangle (f, f->display.x->reverse_gc,
3253 x0, y0, (x1 - x0 + 1), 1);
3254 else if (x1 < x0)
3255 x_rectangle (f, f->display.x->reverse_gc,
3256 x1, y1, (x0 - x1 + 1), 1);
3257 }
3258 UNBLOCK_INPUT;
3259
3260 return Qnil;
3261 }
3262
3263 #if 0
3264 int contour_begin_x, contour_begin_y;
3265 int contour_end_x, contour_end_y;
3266 int contour_npoints;
3267
3268 /* Clip the top part of the contour lines down (and including) line Y_POS.
3269 If X_POS is in the middle (rather than at the end) of the line, drop
3270 down a line at that character. */
3271
3272 static void
3273 clip_contour_top (y_pos, x_pos)
3274 {
3275 register XPoint *begin = contour_lines[y_pos].top_left;
3276 register XPoint *end;
3277 register int npoints;
3278 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
3279
3280 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
3281 {
3282 end = contour_lines[y_pos].top_right;
3283 npoints = (end - begin + 1);
3284 XDrawLines (x_current_display, contour_window,
3285 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3286
3287 bcopy (end, begin + 1, contour_last_point - end + 1);
3288 contour_last_point -= (npoints - 2);
3289 XDrawLines (x_current_display, contour_window,
3290 contour_erase_gc, begin, 2, CoordModeOrigin);
3291 XFlush (x_current_display);
3292
3293 /* Now, update contour_lines structure. */
3294 }
3295 /* ______. */
3296 else /* |________*/
3297 {
3298 register XPoint *p = begin + 1;
3299 end = contour_lines[y_pos].bottom_right;
3300 npoints = (end - begin + 1);
3301 XDrawLines (x_current_display, contour_window,
3302 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3303
3304 p->y = begin->y;
3305 p->x = ibw + (font_w * (x_pos + 1));
3306 p++;
3307 p->y = begin->y + font_h;
3308 p->x = (p - 1)->x;
3309 bcopy (end, begin + 3, contour_last_point - end + 1);
3310 contour_last_point -= (npoints - 5);
3311 XDrawLines (x_current_display, contour_window,
3312 contour_erase_gc, begin, 4, CoordModeOrigin);
3313 XFlush (x_current_display);
3314
3315 /* Now, update contour_lines structure. */
3316 }
3317 }
3318
3319 /* Erase the top horizontal lines of the contour, and then extend
3320 the contour upwards. */
3321
3322 static void
3323 extend_contour_top (line)
3324 {
3325 }
3326
3327 static void
3328 clip_contour_bottom (x_pos, y_pos)
3329 int x_pos, y_pos;
3330 {
3331 }
3332
3333 static void
3334 extend_contour_bottom (x_pos, y_pos)
3335 {
3336 }
3337
3338 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
3339 "")
3340 (event)
3341 Lisp_Object event;
3342 {
3343 register struct frame *f = selected_frame;
3344 register int point_x = f->cursor_x;
3345 register int point_y = f->cursor_y;
3346 register int mouse_below_point;
3347 register Lisp_Object obj;
3348 register int x_contour_x, x_contour_y;
3349
3350 x_contour_x = x_mouse_x;
3351 x_contour_y = x_mouse_y;
3352 if (x_contour_y > point_y || (x_contour_y == point_y
3353 && x_contour_x > point_x))
3354 {
3355 mouse_below_point = 1;
3356 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
3357 x_contour_x, x_contour_y);
3358 }
3359 else
3360 {
3361 mouse_below_point = 0;
3362 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
3363 point_x, point_y);
3364 }
3365
3366 while (1)
3367 {
3368 obj = read_char (-1, 0, 0, Qnil, 0);
3369 if (XTYPE (obj) != Lisp_Cons)
3370 break;
3371
3372 if (mouse_below_point)
3373 {
3374 if (x_mouse_y <= point_y) /* Flipped. */
3375 {
3376 mouse_below_point = 0;
3377
3378 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
3379 x_contour_x, x_contour_y);
3380 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
3381 point_x, point_y);
3382 }
3383 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
3384 {
3385 clip_contour_bottom (x_mouse_y);
3386 }
3387 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
3388 {
3389 extend_bottom_contour (x_mouse_y);
3390 }
3391
3392 x_contour_x = x_mouse_x;
3393 x_contour_y = x_mouse_y;
3394 }
3395 else /* mouse above or same line as point */
3396 {
3397 if (x_mouse_y >= point_y) /* Flipped. */
3398 {
3399 mouse_below_point = 1;
3400
3401 outline_region (f, f->display.x->reverse_gc,
3402 x_contour_x, x_contour_y, point_x, point_y);
3403 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
3404 x_mouse_x, x_mouse_y);
3405 }
3406 else if (x_mouse_y > x_contour_y) /* Top clipped. */
3407 {
3408 clip_contour_top (x_mouse_y);
3409 }
3410 else if (x_mouse_y < x_contour_y) /* Top extended. */
3411 {
3412 extend_contour_top (x_mouse_y);
3413 }
3414 }
3415 }
3416
3417 unread_command_event = obj;
3418 if (mouse_below_point)
3419 {
3420 contour_begin_x = point_x;
3421 contour_begin_y = point_y;
3422 contour_end_x = x_contour_x;
3423 contour_end_y = x_contour_y;
3424 }
3425 else
3426 {
3427 contour_begin_x = x_contour_x;
3428 contour_begin_y = x_contour_y;
3429 contour_end_x = point_x;
3430 contour_end_y = point_y;
3431 }
3432 }
3433 #endif
3434
3435 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
3436 "")
3437 (event)
3438 Lisp_Object event;
3439 {
3440 register Lisp_Object obj;
3441 struct frame *f = selected_frame;
3442 register struct window *w = XWINDOW (selected_window);
3443 register GC line_gc = f->display.x->cursor_gc;
3444 register GC erase_gc = f->display.x->reverse_gc;
3445 #if 0
3446 char dash_list[] = {6, 4, 6, 4};
3447 int dashes = 4;
3448 XGCValues gc_values;
3449 #endif
3450 register int previous_y;
3451 register int line = (x_mouse_y + 1) * f->display.x->line_height
3452 + f->display.x->internal_border_width;
3453 register int left = f->display.x->internal_border_width
3454 + (w->left
3455 * FONT_WIDTH (f->display.x->font));
3456 register int right = left + (w->width
3457 * FONT_WIDTH (f->display.x->font))
3458 - f->display.x->internal_border_width;
3459
3460 #if 0
3461 BLOCK_INPUT;
3462 gc_values.foreground = f->display.x->cursor_pixel;
3463 gc_values.background = f->display.x->background_pixel;
3464 gc_values.line_width = 1;
3465 gc_values.line_style = LineOnOffDash;
3466 gc_values.cap_style = CapRound;
3467 gc_values.join_style = JoinRound;
3468
3469 line_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3470 GCLineStyle | GCJoinStyle | GCCapStyle
3471 | GCLineWidth | GCForeground | GCBackground,
3472 &gc_values);
3473 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
3474 gc_values.foreground = f->display.x->background_pixel;
3475 gc_values.background = f->display.x->foreground_pixel;
3476 erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3477 GCLineStyle | GCJoinStyle | GCCapStyle
3478 | GCLineWidth | GCForeground | GCBackground,
3479 &gc_values);
3480 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
3481 #endif
3482
3483 while (1)
3484 {
3485 BLOCK_INPUT;
3486 if (x_mouse_y >= XINT (w->top)
3487 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3488 {
3489 previous_y = x_mouse_y;
3490 line = (x_mouse_y + 1) * f->display.x->line_height
3491 + f->display.x->internal_border_width;
3492 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3493 line_gc, left, line, right, line);
3494 }
3495 XFlushQueue ();
3496 UNBLOCK_INPUT;
3497
3498 do
3499 {
3500 obj = read_char (-1, 0, 0, Qnil, 0);
3501 if ((XTYPE (obj) != Lisp_Cons)
3502 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
3503 Qvertical_scroll_bar))
3504 || x_mouse_grabbed)
3505 {
3506 BLOCK_INPUT;
3507 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3508 erase_gc, left, line, right, line);
3509 UNBLOCK_INPUT;
3510 unread_command_event = obj;
3511 #if 0
3512 XFreeGC (x_current_display, line_gc);
3513 XFreeGC (x_current_display, erase_gc);
3514 #endif
3515 return Qnil;
3516 }
3517 }
3518 while (x_mouse_y == previous_y);
3519
3520 BLOCK_INPUT;
3521 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3522 erase_gc, left, line, right, line);
3523 UNBLOCK_INPUT;
3524 }
3525 }
3526 #endif
3527 \f
3528 /* Offset in buffer of character under the pointer, or 0. */
3529 int mouse_buffer_offset;
3530
3531 #if 0
3532 /* These keep track of the rectangle following the pointer. */
3533 int mouse_track_top, mouse_track_left, mouse_track_width;
3534
3535 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3536 "Track the pointer.")
3537 ()
3538 {
3539 static Cursor current_pointer_shape;
3540 FRAME_PTR f = x_mouse_frame;
3541
3542 BLOCK_INPUT;
3543 if (EQ (Vmouse_frame_part, Qtext_part)
3544 && (current_pointer_shape != f->display.x->nontext_cursor))
3545 {
3546 unsigned char c;
3547 struct buffer *buf;
3548
3549 current_pointer_shape = f->display.x->nontext_cursor;
3550 XDefineCursor (x_current_display,
3551 FRAME_X_WINDOW (f),
3552 current_pointer_shape);
3553
3554 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3555 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3556 }
3557 else if (EQ (Vmouse_frame_part, Qmodeline_part)
3558 && (current_pointer_shape != f->display.x->modeline_cursor))
3559 {
3560 current_pointer_shape = f->display.x->modeline_cursor;
3561 XDefineCursor (x_current_display,
3562 FRAME_X_WINDOW (f),
3563 current_pointer_shape);
3564 }
3565
3566 XFlushQueue ();
3567 UNBLOCK_INPUT;
3568 }
3569 #endif
3570
3571 #if 0
3572 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3573 "Draw rectangle around character under mouse pointer, if there is one.")
3574 (event)
3575 Lisp_Object event;
3576 {
3577 struct window *w = XWINDOW (Vmouse_window);
3578 struct frame *f = XFRAME (WINDOW_FRAME (w));
3579 struct buffer *b = XBUFFER (w->buffer);
3580 Lisp_Object obj;
3581
3582 if (! EQ (Vmouse_window, selected_window))
3583 return Qnil;
3584
3585 if (EQ (event, Qnil))
3586 {
3587 int x, y;
3588
3589 x_read_mouse_position (selected_frame, &x, &y);
3590 }
3591
3592 BLOCK_INPUT;
3593 mouse_track_width = 0;
3594 mouse_track_left = mouse_track_top = -1;
3595
3596 do
3597 {
3598 if ((x_mouse_x != mouse_track_left
3599 && (x_mouse_x < mouse_track_left
3600 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3601 || x_mouse_y != mouse_track_top)
3602 {
3603 int hp = 0; /* Horizontal position */
3604 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
3605 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
3606 int tab_width = XINT (b->tab_width);
3607 int ctl_arrow_p = !NILP (b->ctl_arrow);
3608 unsigned char c;
3609 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3610 int in_mode_line = 0;
3611
3612 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
3613 break;
3614
3615 /* Erase previous rectangle. */
3616 if (mouse_track_width)
3617 {
3618 x_rectangle (f, f->display.x->reverse_gc,
3619 mouse_track_left, mouse_track_top,
3620 mouse_track_width, 1);
3621
3622 if ((mouse_track_left == f->phys_cursor_x
3623 || mouse_track_left == f->phys_cursor_x - 1)
3624 && mouse_track_top == f->phys_cursor_y)
3625 {
3626 x_display_cursor (f, 1);
3627 }
3628 }
3629
3630 mouse_track_left = x_mouse_x;
3631 mouse_track_top = x_mouse_y;
3632 mouse_track_width = 0;
3633
3634 if (mouse_track_left > len) /* Past the end of line. */
3635 goto draw_or_not;
3636
3637 if (mouse_track_top == mode_line_vpos)
3638 {
3639 in_mode_line = 1;
3640 goto draw_or_not;
3641 }
3642
3643 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3644 do
3645 {
3646 c = FETCH_CHAR (p);
3647 if (len == f->width && hp == len - 1 && c != '\n')
3648 goto draw_or_not;
3649
3650 switch (c)
3651 {
3652 case '\t':
3653 mouse_track_width = tab_width - (hp % tab_width);
3654 p++;
3655 hp += mouse_track_width;
3656 if (hp > x_mouse_x)
3657 {
3658 mouse_track_left = hp - mouse_track_width;
3659 goto draw_or_not;
3660 }
3661 continue;
3662
3663 case '\n':
3664 mouse_track_width = -1;
3665 goto draw_or_not;
3666
3667 default:
3668 if (ctl_arrow_p && (c < 040 || c == 0177))
3669 {
3670 if (p > ZV)
3671 goto draw_or_not;
3672
3673 mouse_track_width = 2;
3674 p++;
3675 hp +=2;
3676 if (hp > x_mouse_x)
3677 {
3678 mouse_track_left = hp - mouse_track_width;
3679 goto draw_or_not;
3680 }
3681 }
3682 else
3683 {
3684 mouse_track_width = 1;
3685 p++;
3686 hp++;
3687 }
3688 continue;
3689 }
3690 }
3691 while (hp <= x_mouse_x);
3692
3693 draw_or_not:
3694 if (mouse_track_width) /* Over text; use text pointer shape. */
3695 {
3696 XDefineCursor (x_current_display,
3697 FRAME_X_WINDOW (f),
3698 f->display.x->text_cursor);
3699 x_rectangle (f, f->display.x->cursor_gc,
3700 mouse_track_left, mouse_track_top,
3701 mouse_track_width, 1);
3702 }
3703 else if (in_mode_line)
3704 XDefineCursor (x_current_display,
3705 FRAME_X_WINDOW (f),
3706 f->display.x->modeline_cursor);
3707 else
3708 XDefineCursor (x_current_display,
3709 FRAME_X_WINDOW (f),
3710 f->display.x->nontext_cursor);
3711 }
3712
3713 XFlush (x_current_display);
3714 UNBLOCK_INPUT;
3715
3716 obj = read_char (-1, 0, 0, Qnil, 0);
3717 BLOCK_INPUT;
3718 }
3719 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
3720 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
3721 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3722 && EQ (Vmouse_window, selected_window) /* In this window */
3723 && x_mouse_frame);
3724
3725 unread_command_event = obj;
3726
3727 if (mouse_track_width)
3728 {
3729 x_rectangle (f, f->display.x->reverse_gc,
3730 mouse_track_left, mouse_track_top,
3731 mouse_track_width, 1);
3732 mouse_track_width = 0;
3733 if ((mouse_track_left == f->phys_cursor_x
3734 || mouse_track_left - 1 == f->phys_cursor_x)
3735 && mouse_track_top == f->phys_cursor_y)
3736 {
3737 x_display_cursor (f, 1);
3738 }
3739 }
3740 XDefineCursor (x_current_display,
3741 FRAME_X_WINDOW (f),
3742 f->display.x->nontext_cursor);
3743 XFlush (x_current_display);
3744 UNBLOCK_INPUT;
3745
3746 return Qnil;
3747 }
3748 #endif
3749 \f
3750 #if 0
3751 #include "glyphs.h"
3752
3753 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3754 on the frame F at position X, Y. */
3755
3756 x_draw_pixmap (f, x, y, image_data, width, height)
3757 struct frame *f;
3758 int x, y, width, height;
3759 char *image_data;
3760 {
3761 Pixmap image;
3762
3763 image = XCreateBitmapFromData (x_current_display,
3764 FRAME_X_WINDOW (f), image_data,
3765 width, height);
3766 XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f),
3767 f->display.x->normal_gc, 0, 0, width, height, x, y);
3768 }
3769 #endif
3770 \f
3771 #if 0 /* I'm told these functions are superfluous
3772 given the ability to bind function keys. */
3773
3774 #ifdef HAVE_X11
3775 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3776 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3777 KEYSYM is a string which conforms to the X keysym definitions found\n\
3778 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3779 list of strings specifying modifier keys such as Control_L, which must\n\
3780 also be depressed for NEWSTRING to appear.")
3781 (x_keysym, modifiers, newstring)
3782 register Lisp_Object x_keysym;
3783 register Lisp_Object modifiers;
3784 register Lisp_Object newstring;
3785 {
3786 char *rawstring;
3787 register KeySym keysym;
3788 KeySym modifier_list[16];
3789
3790 check_x ();
3791 CHECK_STRING (x_keysym, 1);
3792 CHECK_STRING (newstring, 3);
3793
3794 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
3795 if (keysym == NoSymbol)
3796 error ("Keysym does not exist");
3797
3798 if (NILP (modifiers))
3799 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
3800 XSTRING (newstring)->data, XSTRING (newstring)->size);
3801 else
3802 {
3803 register Lisp_Object rest, mod;
3804 register int i = 0;
3805
3806 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
3807 {
3808 if (i == 16)
3809 error ("Can't have more than 16 modifiers");
3810
3811 mod = Fcar (rest);
3812 CHECK_STRING (mod, 3);
3813 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
3814 #ifndef HAVE_X11R5
3815 if (modifier_list[i] == NoSymbol
3816 || !(IsModifierKey (modifier_list[i])
3817 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
3818 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
3819 #else
3820 if (modifier_list[i] == NoSymbol
3821 || !IsModifierKey (modifier_list[i]))
3822 #endif
3823 error ("Element is not a modifier keysym");
3824 i++;
3825 }
3826
3827 XRebindKeysym (x_current_display, keysym, modifier_list, i,
3828 XSTRING (newstring)->data, XSTRING (newstring)->size);
3829 }
3830
3831 return Qnil;
3832 }
3833
3834 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
3835 "Rebind KEYCODE to list of strings STRINGS.\n\
3836 STRINGS should be a list of 16 elements, one for each shift combination.\n\
3837 nil as element means don't change.\n\
3838 See the documentation of `x-rebind-key' for more information.")
3839 (keycode, strings)
3840 register Lisp_Object keycode;
3841 register Lisp_Object strings;
3842 {
3843 register Lisp_Object item;
3844 register unsigned char *rawstring;
3845 KeySym rawkey, modifier[1];
3846 int strsize;
3847 register unsigned i;
3848
3849 check_x ();
3850 CHECK_NUMBER (keycode, 1);
3851 CHECK_CONS (strings, 2);
3852 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
3853 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
3854 {
3855 item = Fcar (strings);
3856 if (!NILP (item))
3857 {
3858 CHECK_STRING (item, 2);
3859 strsize = XSTRING (item)->size;
3860 rawstring = (unsigned char *) xmalloc (strsize);
3861 bcopy (XSTRING (item)->data, rawstring, strsize);
3862 modifier[1] = 1 << i;
3863 XRebindKeysym (x_current_display, rawkey, modifier, 1,
3864 rawstring, strsize);
3865 }
3866 }
3867 return Qnil;
3868 }
3869 #endif /* HAVE_X11 */
3870 #endif /* 0 */
3871 \f
3872 #ifndef HAVE_XSCREENNUMBEROFSCREEN
3873 int
3874 XScreenNumberOfScreen (scr)
3875 register Screen *scr;
3876 {
3877 register Display *dpy;
3878 register Screen *dpyscr;
3879 register int i;
3880
3881 dpy = scr->display;
3882 dpyscr = dpy->screens;
3883
3884 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
3885 if (scr == dpyscr)
3886 return i;
3887
3888 return -1;
3889 }
3890 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
3891
3892 Visual *
3893 select_visual (screen, depth)
3894 Screen *screen;
3895 unsigned int *depth;
3896 {
3897 Visual *v;
3898 XVisualInfo *vinfo, vinfo_template;
3899 int n_visuals;
3900
3901 v = DefaultVisualOfScreen (screen);
3902
3903 #ifdef HAVE_X11R4
3904 vinfo_template.visualid = XVisualIDFromVisual (v);
3905 #else
3906 vinfo_template.visualid = v->visualid;
3907 #endif
3908
3909 vinfo_template.screen = XScreenNumberOfScreen (screen);
3910
3911 vinfo = XGetVisualInfo (x_current_display,
3912 VisualIDMask | VisualScreenMask, &vinfo_template,
3913 &n_visuals);
3914 if (n_visuals != 1)
3915 fatal ("Can't get proper X visual info");
3916
3917 if ((1 << vinfo->depth) == vinfo->colormap_size)
3918 *depth = vinfo->depth;
3919 else
3920 {
3921 int i = 0;
3922 int n = vinfo->colormap_size - 1;
3923 while (n)
3924 {
3925 n = n >> 1;
3926 i++;
3927 }
3928 *depth = i;
3929 }
3930
3931 XFree ((char *) vinfo);
3932 return v;
3933 }
3934
3935 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
3936 1, 2, 0, "Open a connection to an X server.\n\
3937 DISPLAY is the name of the display to connect to.\n\
3938 Optional second arg XRM_STRING is a string of resources in xrdb format.")
3939 (display, xrm_string)
3940 Lisp_Object display, xrm_string;
3941 {
3942 unsigned int n_planes;
3943 unsigned char *xrm_option;
3944
3945 CHECK_STRING (display, 0);
3946 if (x_current_display != 0)
3947 error ("X server connection is already initialized");
3948 if (! NILP (xrm_string))
3949 CHECK_STRING (xrm_string, 1);
3950
3951 if (! NILP (xrm_string))
3952 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
3953 else
3954 xrm_option = (unsigned char *) 0;
3955
3956 validate_x_resource_name ();
3957
3958 /* This is what opens the connection and sets x_current_display.
3959 This also initializes many symbols, such as those used for input. */
3960 x_term_init (XSTRING (display)->data, xrm_option,
3961 XSTRING (Vx_resource_name)->data);
3962
3963 XFASTINT (Vwindow_system_version) = 11;
3964
3965 BLOCK_INPUT;
3966 xrdb = x_load_resources (x_current_display, xrm_option,
3967 (char *) XSTRING (Vx_resource_name)->data,
3968 EMACS_CLASS);
3969 UNBLOCK_INPUT;
3970 #ifdef HAVE_XRMSETDATABASE
3971 XrmSetDatabase (x_current_display, xrdb);
3972 #else
3973 x_current_display->db = xrdb;
3974 #endif
3975
3976 the_x_screen.name = display;
3977
3978 x_screen = DefaultScreenOfDisplay (x_current_display);
3979
3980 screen_visual = select_visual (x_screen, &n_planes);
3981 x_screen_planes = n_planes;
3982 x_screen_height = HeightOfScreen (x_screen);
3983 x_screen_width = WidthOfScreen (x_screen);
3984
3985 /* X Atoms used by emacs. */
3986 Xatoms_of_xselect ();
3987 BLOCK_INPUT;
3988 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
3989 False);
3990 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
3991 False);
3992 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
3993 False);
3994 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
3995 False);
3996 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
3997 False);
3998 Xatom_wm_configure_denied = XInternAtom (x_current_display,
3999 "WM_CONFIGURE_DENIED", False);
4000 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
4001 False);
4002 Xatom_editres_name = XInternAtom (x_current_display, "Editres", False);
4003 UNBLOCK_INPUT;
4004 return Qnil;
4005 }
4006
4007 DEFUN ("x-close-current-connection", Fx_close_current_connection,
4008 Sx_close_current_connection,
4009 0, 0, 0, "Close the connection to the current X server.")
4010 ()
4011 {
4012 /* Note: If we're going to call check_x here, then the fatal error
4013 can't happen. For the moment, this check is just for safety,
4014 so a user won't try out the function and get a crash. If it's
4015 really intended only to be called when killing emacs, then there's
4016 no reason for it to have a lisp interface at all. */
4017 check_x();
4018
4019 /* This is ONLY used when killing emacs; For switching displays
4020 we'll have to take care of setting CloseDownMode elsewhere. */
4021
4022 if (x_current_display)
4023 {
4024 BLOCK_INPUT;
4025 XSetCloseDownMode (x_current_display, DestroyAll);
4026 XCloseDisplay (x_current_display);
4027 x_current_display = 0;
4028 }
4029 else
4030 fatal ("No current X display connection to close\n");
4031
4032 return Qnil;
4033 }
4034
4035 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
4036 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4037 If ON is nil, allow buffering of requests.\n\
4038 Turning on synchronization prohibits the Xlib routines from buffering\n\
4039 requests and seriously degrades performance, but makes debugging much\n\
4040 easier.")
4041 (on)
4042 Lisp_Object on;
4043 {
4044 check_x ();
4045
4046 XSynchronize (x_current_display, !EQ (on, Qnil));
4047
4048 return Qnil;
4049 }
4050
4051 /* Wait for responses to all X commands issued so far for FRAME. */
4052
4053 void
4054 x_sync (frame)
4055 Lisp_Object frame;
4056 {
4057 BLOCK_INPUT;
4058 XSync (x_current_display, False);
4059 UNBLOCK_INPUT;
4060 }
4061 \f
4062 syms_of_xfns ()
4063 {
4064 /* This is zero if not using X windows. */
4065 x_current_display = 0;
4066
4067 the_x_screen.font_list_cache = Qnil;
4068 the_x_screen.name = Qnil;
4069 staticpro (&the_x_screen.font_list_cache);
4070 staticpro (&the_x_screen.name);
4071
4072 /* The section below is built by the lisp expression at the top of the file,
4073 just above where these variables are declared. */
4074 /*&&& init symbols here &&&*/
4075 Qauto_raise = intern ("auto-raise");
4076 staticpro (&Qauto_raise);
4077 Qauto_lower = intern ("auto-lower");
4078 staticpro (&Qauto_lower);
4079 Qbackground_color = intern ("background-color");
4080 staticpro (&Qbackground_color);
4081 Qbar = intern ("bar");
4082 staticpro (&Qbar);
4083 Qborder_color = intern ("border-color");
4084 staticpro (&Qborder_color);
4085 Qborder_width = intern ("border-width");
4086 staticpro (&Qborder_width);
4087 Qbox = intern ("box");
4088 staticpro (&Qbox);
4089 Qcursor_color = intern ("cursor-color");
4090 staticpro (&Qcursor_color);
4091 Qcursor_type = intern ("cursor-type");
4092 staticpro (&Qcursor_type);
4093 Qfont = intern ("font");
4094 staticpro (&Qfont);
4095 Qforeground_color = intern ("foreground-color");
4096 staticpro (&Qforeground_color);
4097 Qgeometry = intern ("geometry");
4098 staticpro (&Qgeometry);
4099 Qicon_left = intern ("icon-left");
4100 staticpro (&Qicon_left);
4101 Qicon_top = intern ("icon-top");
4102 staticpro (&Qicon_top);
4103 Qicon_type = intern ("icon-type");
4104 staticpro (&Qicon_type);
4105 Qinternal_border_width = intern ("internal-border-width");
4106 staticpro (&Qinternal_border_width);
4107 Qleft = intern ("left");
4108 staticpro (&Qleft);
4109 Qmouse_color = intern ("mouse-color");
4110 staticpro (&Qmouse_color);
4111 Qnone = intern ("none");
4112 staticpro (&Qnone);
4113 Qparent_id = intern ("parent-id");
4114 staticpro (&Qparent_id);
4115 Qscroll_bar_width = intern ("scroll-bar-width");
4116 staticpro (&Qscroll_bar_width);
4117 Qsuppress_icon = intern ("suppress-icon");
4118 staticpro (&Qsuppress_icon);
4119 Qtop = intern ("top");
4120 staticpro (&Qtop);
4121 Qundefined_color = intern ("undefined-color");
4122 staticpro (&Qundefined_color);
4123 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
4124 staticpro (&Qvertical_scroll_bars);
4125 Qvisibility = intern ("visibility");
4126 staticpro (&Qvisibility);
4127 Qwindow_id = intern ("window-id");
4128 staticpro (&Qwindow_id);
4129 Qx_frame_parameter = intern ("x-frame-parameter");
4130 staticpro (&Qx_frame_parameter);
4131 Qx_resource_name = intern ("x-resource-name");
4132 staticpro (&Qx_resource_name);
4133 Quser_position = intern ("user-position");
4134 staticpro (&Quser_position);
4135 Quser_size = intern ("user-size");
4136 staticpro (&Quser_size);
4137 /* This is the end of symbol initialization. */
4138
4139 Fput (Qundefined_color, Qerror_conditions,
4140 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
4141 Fput (Qundefined_color, Qerror_message,
4142 build_string ("Undefined color"));
4143
4144 init_x_parm_symbols ();
4145
4146 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
4147 "The buffer offset of the character under the pointer.");
4148 mouse_buffer_offset = 0;
4149
4150 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
4151 "The shape of the pointer when over text.\n\
4152 Changing the value does not affect existing frames\n\
4153 unless you set the mouse color.");
4154 Vx_pointer_shape = Qnil;
4155
4156 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4157 "The name Emacs uses to look up X resources; for internal use only.\n\
4158 `x-get-resource' uses this as the first component of the instance name\n\
4159 when requesting resource values.\n\
4160 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4161 was invoked, or to the value specified with the `-name' or `-rn'\n\
4162 switches, if present.");
4163 Vx_resource_name = Qnil;
4164
4165 #if 0 /* This doesn't really do anything. */
4166 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
4167 "The shape of the pointer when not over text.\n\
4168 This variable takes effect when you create a new frame\n\
4169 or when you set the mouse color.");
4170 #endif
4171 Vx_nontext_pointer_shape = Qnil;
4172
4173 #if 0 /* This doesn't really do anything. */
4174 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
4175 "The shape of the pointer when over the mode line.\n\
4176 This variable takes effect when you create a new frame\n\
4177 or when you set the mouse color.");
4178 #endif
4179 Vx_mode_pointer_shape = Qnil;
4180
4181 DEFVAR_INT ("x-sensitive-text-pointer-shape",
4182 &Vx_sensitive_text_pointer_shape,
4183 "The shape of the pointer when over mouse-sensitive text.\n\
4184 This variable takes effect when you create a new frame\n\
4185 or when you set the mouse color.");
4186 Vx_sensitive_text_pointer_shape = Qnil;
4187
4188 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
4189 "A string indicating the foreground color of the cursor box.");
4190 Vx_cursor_fore_pixel = Qnil;
4191
4192 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
4193 "Non-nil if a mouse button is currently depressed.");
4194 Vmouse_depressed = Qnil;
4195
4196 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
4197 "Non-nil if no X window manager is in use.");
4198
4199 #ifdef USE_X_TOOLKIT
4200 Fprovide (intern ("x-toolkit"));
4201 #endif
4202
4203 defsubr (&Sx_get_resource);
4204 #if 0
4205 defsubr (&Sx_draw_rectangle);
4206 defsubr (&Sx_erase_rectangle);
4207 defsubr (&Sx_contour_region);
4208 defsubr (&Sx_uncontour_region);
4209 #endif
4210 defsubr (&Sx_list_fonts);
4211 defsubr (&Sx_display_color_p);
4212 defsubr (&Sx_display_grayscale_p);
4213 defsubr (&Sx_color_defined_p);
4214 defsubr (&Sx_color_values);
4215 defsubr (&Sx_server_max_request_size);
4216 defsubr (&Sx_server_vendor);
4217 defsubr (&Sx_server_version);
4218 defsubr (&Sx_display_pixel_width);
4219 defsubr (&Sx_display_pixel_height);
4220 defsubr (&Sx_display_mm_width);
4221 defsubr (&Sx_display_mm_height);
4222 defsubr (&Sx_display_screens);
4223 defsubr (&Sx_display_planes);
4224 defsubr (&Sx_display_color_cells);
4225 defsubr (&Sx_display_visual_class);
4226 defsubr (&Sx_display_backing_store);
4227 defsubr (&Sx_display_save_under);
4228 #if 0
4229 defsubr (&Sx_rebind_key);
4230 defsubr (&Sx_rebind_keys);
4231 defsubr (&Sx_track_pointer);
4232 defsubr (&Sx_grab_pointer);
4233 defsubr (&Sx_ungrab_pointer);
4234 #endif
4235 defsubr (&Sx_parse_geometry);
4236 defsubr (&Sx_create_frame);
4237 defsubr (&Sfocus_frame);
4238 defsubr (&Sunfocus_frame);
4239 #if 0
4240 defsubr (&Sx_horizontal_line);
4241 #endif
4242 defsubr (&Sx_open_connection);
4243 defsubr (&Sx_close_current_connection);
4244 defsubr (&Sx_synchronize);
4245 }
4246
4247 #endif /* HAVE_X_WINDOWS */