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