comint-password-prompt-regexp: New variable.
[emacs.git] / src / xfns.c
blob1d513c806afaee17570403e4aafdc67ed14fe626
1 /* Functions for the X window system.
2 Copyright (C) 1989, 1992, 1993, 1994 Free Software Foundation.
4 This file is part of GNU Emacs.
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.
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.
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. */
20 /* Completely rewritten by Richard Stallman. */
22 /* Rewritten for X11 by Joseph Arceneaux */
24 #include <signal.h>
25 #include <config.h>
27 #if 0
28 #include <stdio.h>
29 #endif
31 #include "lisp.h"
32 #include "xterm.h"
33 #include "frame.h"
34 #include "window.h"
35 #include "buffer.h"
36 #include "dispextern.h"
37 #include "keyboard.h"
38 #include "blockinput.h"
40 #ifdef HAVE_X_WINDOWS
41 extern void abort ();
43 #ifndef VMS
44 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
45 #include "bitmaps/gray.xbm"
46 #else
47 #include <X11/bitmaps/gray>
48 #endif
49 #else
50 #include "[.bitmaps]gray.xbm"
51 #endif
53 #ifdef USE_X_TOOLKIT
54 #include <X11/Shell.h>
56 #include <X11/Xaw/Paned.h>
57 #include <X11/Xaw/Label.h>
59 #ifdef USG
60 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
61 #include <X11/Xos.h>
62 #define USG
63 #else
64 #include <X11/Xos.h>
65 #endif
67 #include "widget.h"
69 #include "../lwlib/lwlib.h"
71 /* The one and only application context associated with the connection
72 to the one and only X display that Emacs uses. */
73 XtAppContext Xt_app_con;
75 /* The one and only application shell. Emacs screens are popup shells of this
76 application. */
77 Widget Xt_app_shell;
79 extern void free_frame_menubar ();
80 extern void free_frame_menubar ();
81 #endif /* USE_X_TOOLKIT */
83 #define min(a,b) ((a) < (b) ? (a) : (b))
84 #define max(a,b) ((a) > (b) ? (a) : (b))
86 #ifdef HAVE_X11
87 /* X Resource data base */
88 static XrmDatabase xrdb;
90 /* The class of this X application. */
91 #define EMACS_CLASS "Emacs"
93 #ifdef HAVE_X11R4
94 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
95 #else
96 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
97 #endif
99 /* The name we're using in resource queries. */
100 Lisp_Object Vx_resource_name;
102 /* Title name and application name for X stuff. */
103 extern char *x_id_name;
105 /* The background and shape of the mouse pointer, and shape when not
106 over text or in the modeline. */
107 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
108 /* The shape when over mouse-sensitive text. */
109 Lisp_Object Vx_sensitive_text_pointer_shape;
111 /* Color of chars displayed in cursor box. */
112 Lisp_Object Vx_cursor_fore_pixel;
114 /* The screen being used. */
115 static Screen *x_screen;
117 /* The X Visual we are using for X windows (the default) */
118 Visual *screen_visual;
120 /* Height of this X screen in pixels. */
121 int x_screen_height;
123 /* Width of this X screen in pixels. */
124 int x_screen_width;
126 /* Number of planes for this screen. */
127 int x_screen_planes;
129 /* Non nil if no window manager is in use. */
130 Lisp_Object Vx_no_window_manager;
132 /* `t' if a mouse button is depressed. */
134 Lisp_Object Vmouse_depressed;
136 extern unsigned int x_mouse_x, x_mouse_y, x_mouse_grabbed;
138 /* Atom for indicating window state to the window manager. */
139 extern Atom Xatom_wm_change_state;
141 /* Communication with window managers. */
142 extern Atom Xatom_wm_protocols;
144 /* Kinds of protocol things we may receive. */
145 extern Atom Xatom_wm_take_focus;
146 extern Atom Xatom_wm_save_yourself;
147 extern Atom Xatom_wm_delete_window;
149 /* Other WM communication */
150 extern Atom Xatom_wm_configure_denied; /* When our config request is denied */
151 extern Atom Xatom_wm_window_moved; /* When the WM moves us. */
153 /* EditRes protocol */
154 extern Atom Xatom_editres_name;
156 #else /* X10 */
158 /* Default size of an Emacs window. */
159 static char *default_window = "=80x24+0+0";
161 #define MAXICID 80
162 char iconidentity[MAXICID];
163 #define ICONTAG "emacs@"
164 char minibuffer_iconidentity[MAXICID];
165 #define MINIBUFFER_ICONTAG "minibuffer@"
167 #endif /* X10 */
169 /* The last 23 bits of the timestamp of the last mouse button event. */
170 Time mouse_timestamp;
172 /* Evaluate this expression to rebuild the section of syms_of_xfns
173 that initializes and staticpros the symbols declared below. Note
174 that Emacs 18 has a bug that keeps C-x C-e from being able to
175 evaluate this expression.
177 (progn
178 ;; Accumulate a list of the symbols we want to initialize from the
179 ;; declarations at the top of the file.
180 (goto-char (point-min))
181 (search-forward "/\*&&& symbols declared here &&&*\/\n")
182 (let (symbol-list)
183 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
184 (setq symbol-list
185 (cons (buffer-substring (match-beginning 1) (match-end 1))
186 symbol-list))
187 (forward-line 1))
188 (setq symbol-list (nreverse symbol-list))
189 ;; Delete the section of syms_of_... where we initialize the symbols.
190 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
191 (let ((start (point)))
192 (while (looking-at "^ Q")
193 (forward-line 2))
194 (kill-region start (point)))
195 ;; Write a new symbol initialization section.
196 (while symbol-list
197 (insert (format " %s = intern (\"" (car symbol-list)))
198 (let ((start (point)))
199 (insert (substring (car symbol-list) 1))
200 (subst-char-in-region start (point) ?_ ?-))
201 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
202 (setq symbol-list (cdr symbol-list)))))
206 /*&&& symbols declared here &&&*/
207 Lisp_Object Qauto_raise;
208 Lisp_Object Qauto_lower;
209 Lisp_Object Qbackground_color;
210 Lisp_Object Qbar;
211 Lisp_Object Qborder_color;
212 Lisp_Object Qborder_width;
213 Lisp_Object Qbox;
214 Lisp_Object Qcursor_color;
215 Lisp_Object Qcursor_type;
216 Lisp_Object Qfont;
217 Lisp_Object Qforeground_color;
218 Lisp_Object Qgeometry;
219 /* Lisp_Object Qicon; */
220 Lisp_Object Qicon_left;
221 Lisp_Object Qicon_top;
222 Lisp_Object Qicon_type;
223 Lisp_Object Qinternal_border_width;
224 Lisp_Object Qleft;
225 Lisp_Object Qmouse_color;
226 Lisp_Object Qnone;
227 Lisp_Object Qparent_id;
228 Lisp_Object Qsuppress_icon;
229 Lisp_Object Qtop;
230 Lisp_Object Qundefined_color;
231 Lisp_Object Qvertical_scroll_bars;
232 Lisp_Object Qvisibility;
233 Lisp_Object Qwindow_id;
234 Lisp_Object Qx_frame_parameter;
235 Lisp_Object Qx_resource_name;
236 Lisp_Object Quser_position;
237 Lisp_Object Quser_size;
239 /* The below are defined in frame.c. */
240 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
241 extern Lisp_Object Qunsplittable, Qmenu_bar_lines;
243 extern Lisp_Object Vwindow_system_version;
246 /* Error if we are not connected to X. */
247 void
248 check_x ()
250 if (x_current_display == 0)
251 error ("X windows are not in use or not initialized");
254 /* Nonzero if using X for display. */
257 using_x_p ()
259 return x_current_display != 0;
262 /* Return the Emacs frame-object corresponding to an X window.
263 It could be the frame's main window or an icon window. */
265 /* This function can be called during GC, so use XGCTYPE. */
267 struct frame *
268 x_window_to_frame (wdesc)
269 int wdesc;
271 Lisp_Object tail, frame;
272 struct frame *f;
274 for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
275 tail = XCONS (tail)->cdr)
277 frame = XCONS (tail)->car;
278 if (XGCTYPE (frame) != Lisp_Frame)
279 continue;
280 f = XFRAME (frame);
281 #ifdef USE_X_TOOLKIT
282 if (f->display.nothing == 1)
283 return 0;
284 if ((f->display.x->edit_widget
285 && XtWindow (f->display.x->edit_widget) == wdesc)
286 || f->display.x->icon_desc == wdesc)
287 return f;
288 #else /* not USE_X_TOOLKIT */
289 if (FRAME_X_WINDOW (f) == wdesc
290 || f->display.x->icon_desc == wdesc)
291 return f;
292 #endif /* not USE_X_TOOLKIT */
294 return 0;
297 #ifdef USE_X_TOOLKIT
298 /* Like x_window_to_frame but also compares the window with the widget's
299 windows. */
301 struct frame *
302 x_any_window_to_frame (wdesc)
303 int wdesc;
305 Lisp_Object tail, frame;
306 struct frame *f;
307 struct x_display *x;
309 for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
310 tail = XCONS (tail)->cdr)
312 frame = XCONS (tail)->car;
313 if (XGCTYPE (frame) != Lisp_Frame)
314 continue;
315 f = XFRAME (frame);
316 if (f->display.nothing == 1)
317 return 0;
318 x = f->display.x;
319 /* This frame matches if the window is any of its widgets. */
320 if (wdesc == XtWindow (x->widget)
321 || wdesc == XtWindow (x->column_widget)
322 || wdesc == XtWindow (x->edit_widget))
323 return f;
324 /* Match if the window is this frame's menubar. */
325 if (x->menubar_widget
326 && wdesc == XtWindow (x->menubar_widget))
327 return f;
329 return 0;
332 /* Return the frame whose principal (outermost) window is WDESC.
333 If WDESC is some other (smaller) window, we return 0. */
335 struct frame *
336 x_top_window_to_frame (wdesc)
337 int wdesc;
339 Lisp_Object tail, frame;
340 struct frame *f;
341 struct x_display *x;
343 for (tail = Vframe_list; XGCTYPE (tail) == Lisp_Cons;
344 tail = XCONS (tail)->cdr)
346 frame = XCONS (tail)->car;
347 if (XGCTYPE (frame) != Lisp_Frame)
348 continue;
349 f = XFRAME (frame);
350 if (f->display.nothing == 1)
351 return 0;
352 x = f->display.x;
353 /* This frame matches if the window is its topmost widget. */
354 if (wdesc == XtWindow (x->widget))
355 return f;
356 /* Match if the window is this frame's menubar. */
357 if (x->menubar_widget
358 && wdesc == XtWindow (x->menubar_widget))
359 return f;
361 return 0;
363 #endif /* USE_X_TOOLKIT */
366 /* Connect the frame-parameter names for X frames
367 to the ways of passing the parameter values to the window system.
369 The name of a parameter, as a Lisp symbol,
370 has an `x-frame-parameter' property which is an integer in Lisp
371 but can be interpreted as an `enum x_frame_parm' in C. */
373 enum x_frame_parm
375 X_PARM_FOREGROUND_COLOR,
376 X_PARM_BACKGROUND_COLOR,
377 X_PARM_MOUSE_COLOR,
378 X_PARM_CURSOR_COLOR,
379 X_PARM_BORDER_COLOR,
380 X_PARM_ICON_TYPE,
381 X_PARM_FONT,
382 X_PARM_BORDER_WIDTH,
383 X_PARM_INTERNAL_BORDER_WIDTH,
384 X_PARM_NAME,
385 X_PARM_AUTORAISE,
386 X_PARM_AUTOLOWER,
387 X_PARM_VERT_SCROLL_BAR,
388 X_PARM_VISIBILITY,
389 X_PARM_MENU_BAR_LINES
393 struct x_frame_parm_table
395 char *name;
396 void (*setter)( /* struct frame *frame, Lisp_Object val, oldval */ );
399 void x_set_foreground_color ();
400 void x_set_background_color ();
401 void x_set_mouse_color ();
402 void x_set_cursor_color ();
403 void x_set_border_color ();
404 void x_set_cursor_type ();
405 void x_set_icon_type ();
406 void x_set_font ();
407 void x_set_border_width ();
408 void x_set_internal_border_width ();
409 void x_explicitly_set_name ();
410 void x_set_autoraise ();
411 void x_set_autolower ();
412 void x_set_vertical_scroll_bars ();
413 void x_set_visibility ();
414 void x_set_menu_bar_lines ();
416 static struct x_frame_parm_table x_frame_parms[] =
418 "foreground-color", x_set_foreground_color,
419 "background-color", x_set_background_color,
420 "mouse-color", x_set_mouse_color,
421 "cursor-color", x_set_cursor_color,
422 "border-color", x_set_border_color,
423 "cursor-type", x_set_cursor_type,
424 "icon-type", x_set_icon_type,
425 "font", x_set_font,
426 "border-width", x_set_border_width,
427 "internal-border-width", x_set_internal_border_width,
428 "name", x_explicitly_set_name,
429 "auto-raise", x_set_autoraise,
430 "auto-lower", x_set_autolower,
431 "vertical-scroll-bars", x_set_vertical_scroll_bars,
432 "visibility", x_set_visibility,
433 "menu-bar-lines", x_set_menu_bar_lines,
436 /* Attach the `x-frame-parameter' properties to
437 the Lisp symbol names of parameters relevant to X. */
439 init_x_parm_symbols ()
441 int i;
443 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
444 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
445 make_number (i));
448 /* Change the parameters of FRAME as specified by ALIST.
449 If a parameter is not specially recognized, do nothing;
450 otherwise call the `x_set_...' function for that parameter. */
452 void
453 x_set_frame_parameters (f, alist)
454 FRAME_PTR f;
455 Lisp_Object alist;
457 Lisp_Object tail;
459 /* If both of these parameters are present, it's more efficient to
460 set them both at once. So we wait until we've looked at the
461 entire list before we set them. */
462 Lisp_Object width, height;
464 /* Same here. */
465 Lisp_Object left, top;
467 /* Record in these vectors all the parms specified. */
468 Lisp_Object *parms;
469 Lisp_Object *values;
470 int i;
472 i = 0;
473 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
474 i++;
476 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
477 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
479 /* Extract parm names and values into those vectors. */
481 i = 0;
482 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
484 Lisp_Object elt, prop, val;
486 elt = Fcar (tail);
487 parms[i] = Fcar (elt);
488 values[i] = Fcdr (elt);
489 i++;
492 width = height = top = left = Qunbound;
494 /* Now process them in reverse of specified order. */
495 for (i--; i >= 0; i--)
497 Lisp_Object prop, val;
499 prop = parms[i];
500 val = values[i];
502 if (EQ (prop, Qwidth))
503 width = val;
504 else if (EQ (prop, Qheight))
505 height = val;
506 else if (EQ (prop, Qtop))
507 top = val;
508 else if (EQ (prop, Qleft))
509 left = val;
510 else
512 register Lisp_Object param_index, old_value;
514 param_index = Fget (prop, Qx_frame_parameter);
515 old_value = get_frame_param (f, prop);
516 store_frame_param (f, prop, val);
517 if (XTYPE (param_index) == Lisp_Int
518 && XINT (param_index) >= 0
519 && (XINT (param_index)
520 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
521 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
525 /* Don't die if just one of these was set. */
526 if (EQ (left, Qunbound))
527 XSET (left, Lisp_Int, f->display.x->left_pos);
528 if (EQ (top, Qunbound))
529 XSET (top, Lisp_Int, f->display.x->top_pos);
531 /* Don't die if just one of these was set. */
532 if (EQ (width, Qunbound))
533 XSET (width, Lisp_Int, FRAME_WIDTH (f));
534 if (EQ (height, Qunbound))
535 XSET (height, Lisp_Int, FRAME_HEIGHT (f));
537 /* Don't set these parameters these unless they've been explicitly
538 specified. The window might be mapped or resized while we're in
539 this function, and we don't want to override that unless the lisp
540 code has asked for it.
542 Don't set these parameters unless they actually differ from the
543 window's current parameters; the window may not actually exist
544 yet. */
546 Lisp_Object frame;
548 check_frame_size (f, &height, &width);
550 XSET (frame, Lisp_Frame, f);
552 if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f))
553 || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f)))
554 Fset_frame_size (frame, width, height);
555 if ((NUMBERP (left) && XINT (left) != f->display.x->left_pos)
556 || (NUMBERP (top) && XINT (top) != f->display.x->top_pos))
557 Fset_frame_position (frame, left, top);
561 /* Store the positions of frame F into XPTR and YPTR.
562 These are the positions of the containing window manager window,
563 not Emacs's own window. */
565 void
566 x_real_positions (f, xptr, yptr)
567 FRAME_PTR f;
568 int *xptr, *yptr;
570 int win_x = 0, win_y = 0;
571 Window child;
573 /* This is pretty gross, but seems to be the easiest way out of
574 the problem that arises when restarting window-managers. */
576 #ifdef USE_X_TOOLKIT
577 Window outer = XtWindow (f->display.x->widget);
578 #else
579 Window outer = f->display.x->window_desc;
580 #endif
581 Window tmp_root_window;
582 Window *tmp_children;
583 int tmp_nchildren;
585 XQueryTree (x_current_display, outer, &tmp_root_window,
586 &f->display.x->parent_desc,
587 &tmp_children, &tmp_nchildren);
588 xfree (tmp_children);
590 /* Find the position of the outside upper-left corner of
591 the inner window, with respect to the outer window. */
592 if (f->display.x->parent_desc != ROOT_WINDOW)
594 BLOCK_INPUT;
595 XTranslateCoordinates (x_current_display,
597 /* From-window, to-window. */
598 #ifdef USE_X_TOOLKIT
599 XtWindow (f->display.x->widget),
600 #else
601 f->display.x->window_desc,
602 #endif
603 f->display.x->parent_desc,
605 /* From-position, to-position. */
606 0, 0, &win_x, &win_y,
608 /* Child of win. */
609 &child);
610 UNBLOCK_INPUT;
612 win_x += f->display.x->border_width;
613 win_y += f->display.x->border_width;
615 *xptr = f->display.x->left_pos - win_x;
616 *yptr = f->display.x->top_pos - win_y;
619 /* Insert a description of internally-recorded parameters of frame X
620 into the parameter alist *ALISTPTR that is to be given to the user.
621 Only parameters that are specific to the X window system
622 and whose values are not correctly recorded in the frame's
623 param_alist need to be considered here. */
625 x_report_frame_params (f, alistptr)
626 struct frame *f;
627 Lisp_Object *alistptr;
629 char buf[16];
631 store_in_alist (alistptr, Qleft, make_number (f->display.x->left_pos));
632 store_in_alist (alistptr, Qtop, make_number (f->display.x->top_pos));
633 store_in_alist (alistptr, Qborder_width,
634 make_number (f->display.x->border_width));
635 store_in_alist (alistptr, Qinternal_border_width,
636 make_number (f->display.x->internal_border_width));
637 sprintf (buf, "%d", FRAME_X_WINDOW (f));
638 store_in_alist (alistptr, Qwindow_id,
639 build_string (buf));
640 FRAME_SAMPLE_VISIBILITY (f);
641 store_in_alist (alistptr, Qvisibility,
642 (FRAME_VISIBLE_P (f) ? Qt
643 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
646 /* Decide if color named COLOR is valid for the display
647 associated with the selected frame. */
649 defined_color (color, color_def)
650 char *color;
651 Color *color_def;
653 register int foo;
654 Colormap screen_colormap;
656 BLOCK_INPUT;
657 #ifdef HAVE_X11
658 screen_colormap
659 = DefaultColormap (x_current_display, XDefaultScreen (x_current_display));
661 foo = XParseColor (x_current_display, screen_colormap,
662 color, color_def)
663 && XAllocColor (x_current_display, screen_colormap, color_def);
664 #else
665 foo = XParseColor (color, color_def) && XGetHardwareColor (color_def);
666 #endif /* not HAVE_X11 */
667 UNBLOCK_INPUT;
669 if (foo)
670 return 1;
671 else
672 return 0;
675 /* Given a string ARG naming a color, compute a pixel value from it
676 suitable for screen F.
677 If F is not a color screen, return DEF (default) regardless of what
678 ARG says. */
681 x_decode_color (arg, def)
682 Lisp_Object arg;
683 int def;
685 Color cdef;
687 CHECK_STRING (arg, 0);
689 if (strcmp (XSTRING (arg)->data, "black") == 0)
690 return BLACK_PIX_DEFAULT;
691 else if (strcmp (XSTRING (arg)->data, "white") == 0)
692 return WHITE_PIX_DEFAULT;
694 #ifdef HAVE_X11
695 if (x_screen_planes == 1)
696 return def;
697 #else
698 if (DISPLAY_CELLS == 1)
699 return def;
700 #endif
702 if (defined_color (XSTRING (arg)->data, &cdef))
703 return cdef.pixel;
704 else
705 Fsignal (Qundefined_color, Fcons (arg, Qnil));
708 /* Functions called only from `x_set_frame_param'
709 to set individual parameters.
711 If FRAME_X_WINDOW (f) is 0,
712 the frame is being created and its X-window does not exist yet.
713 In that case, just record the parameter's new value
714 in the standard place; do not attempt to change the window. */
716 void
717 x_set_foreground_color (f, arg, oldval)
718 struct frame *f;
719 Lisp_Object arg, oldval;
721 f->display.x->foreground_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
722 if (FRAME_X_WINDOW (f) != 0)
724 #ifdef HAVE_X11
725 BLOCK_INPUT;
726 XSetForeground (x_current_display, f->display.x->normal_gc,
727 f->display.x->foreground_pixel);
728 XSetBackground (x_current_display, f->display.x->reverse_gc,
729 f->display.x->foreground_pixel);
730 UNBLOCK_INPUT;
731 #endif /* HAVE_X11 */
732 recompute_basic_faces (f);
733 if (FRAME_VISIBLE_P (f))
734 redraw_frame (f);
738 void
739 x_set_background_color (f, arg, oldval)
740 struct frame *f;
741 Lisp_Object arg, oldval;
743 Pixmap temp;
744 int mask;
746 f->display.x->background_pixel = x_decode_color (arg, WHITE_PIX_DEFAULT);
748 if (FRAME_X_WINDOW (f) != 0)
750 BLOCK_INPUT;
751 #ifdef HAVE_X11
752 /* The main frame area. */
753 XSetBackground (x_current_display, f->display.x->normal_gc,
754 f->display.x->background_pixel);
755 XSetForeground (x_current_display, f->display.x->reverse_gc,
756 f->display.x->background_pixel);
757 XSetForeground (x_current_display, f->display.x->cursor_gc,
758 f->display.x->background_pixel);
759 XSetWindowBackground (x_current_display, FRAME_X_WINDOW (f),
760 f->display.x->background_pixel);
762 Lisp_Object bar;
763 for (bar = FRAME_SCROLL_BARS (f); !NILP (bar);
764 bar = XSCROLL_BAR (bar)->next)
765 XSetWindowBackground (x_current_display,
766 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)),
767 f->display.x->background_pixel);
769 #else
770 temp = XMakeTile (f->display.x->background_pixel);
771 XChangeBackground (FRAME_X_WINDOW (f), temp);
772 XFreePixmap (temp);
773 #endif /* not HAVE_X11 */
774 UNBLOCK_INPUT;
776 recompute_basic_faces (f);
778 if (FRAME_VISIBLE_P (f))
779 redraw_frame (f);
783 void
784 x_set_mouse_color (f, arg, oldval)
785 struct frame *f;
786 Lisp_Object arg, oldval;
788 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
789 int mask_color;
791 if (!EQ (Qnil, arg))
792 f->display.x->mouse_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
793 mask_color = f->display.x->background_pixel;
794 /* No invisible pointers. */
795 if (mask_color == f->display.x->mouse_pixel
796 && mask_color == f->display.x->background_pixel)
797 f->display.x->mouse_pixel = f->display.x->foreground_pixel;
799 BLOCK_INPUT;
800 #ifdef HAVE_X11
802 /* It's not okay to crash if the user selects a screwy cursor. */
803 x_catch_errors ();
805 if (!EQ (Qnil, Vx_pointer_shape))
807 CHECK_NUMBER (Vx_pointer_shape, 0);
808 cursor = XCreateFontCursor (x_current_display, XINT (Vx_pointer_shape));
810 else
811 cursor = XCreateFontCursor (x_current_display, XC_xterm);
812 x_check_errors ("bad text pointer cursor: %s");
814 if (!EQ (Qnil, Vx_nontext_pointer_shape))
816 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
817 nontext_cursor = XCreateFontCursor (x_current_display,
818 XINT (Vx_nontext_pointer_shape));
820 else
821 nontext_cursor = XCreateFontCursor (x_current_display, XC_left_ptr);
822 x_check_errors ("bad nontext pointer cursor: %s");
824 if (!EQ (Qnil, Vx_mode_pointer_shape))
826 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
827 mode_cursor = XCreateFontCursor (x_current_display,
828 XINT (Vx_mode_pointer_shape));
830 else
831 mode_cursor = XCreateFontCursor (x_current_display, XC_xterm);
832 x_check_errors ("bad modeline pointer cursor: %s");
834 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
836 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
837 cross_cursor
838 = XCreateFontCursor (x_current_display,
839 XINT (Vx_sensitive_text_pointer_shape));
841 else
842 cross_cursor = XCreateFontCursor (x_current_display, XC_crosshair);
844 /* Check and report errors with the above calls. */
845 x_check_errors ("can't set cursor shape: %s");
846 x_uncatch_errors ();
849 XColor fore_color, back_color;
851 fore_color.pixel = f->display.x->mouse_pixel;
852 back_color.pixel = mask_color;
853 XQueryColor (x_current_display,
854 DefaultColormap (x_current_display,
855 DefaultScreen (x_current_display)),
856 &fore_color);
857 XQueryColor (x_current_display,
858 DefaultColormap (x_current_display,
859 DefaultScreen (x_current_display)),
860 &back_color);
861 XRecolorCursor (x_current_display, cursor,
862 &fore_color, &back_color);
863 XRecolorCursor (x_current_display, nontext_cursor,
864 &fore_color, &back_color);
865 XRecolorCursor (x_current_display, mode_cursor,
866 &fore_color, &back_color);
867 XRecolorCursor (x_current_display, cross_cursor,
868 &fore_color, &back_color);
870 #else /* X10 */
871 cursor = XCreateCursor (16, 16, MouseCursor, MouseMask,
872 0, 0,
873 f->display.x->mouse_pixel,
874 f->display.x->background_pixel,
875 GXcopy);
876 #endif /* X10 */
878 if (FRAME_X_WINDOW (f) != 0)
880 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f), cursor);
883 if (cursor != f->display.x->text_cursor && f->display.x->text_cursor != 0)
884 XFreeCursor (XDISPLAY f->display.x->text_cursor);
885 f->display.x->text_cursor = cursor;
886 #ifdef HAVE_X11
887 if (nontext_cursor != f->display.x->nontext_cursor
888 && f->display.x->nontext_cursor != 0)
889 XFreeCursor (XDISPLAY f->display.x->nontext_cursor);
890 f->display.x->nontext_cursor = nontext_cursor;
892 if (mode_cursor != f->display.x->modeline_cursor
893 && f->display.x->modeline_cursor != 0)
894 XFreeCursor (XDISPLAY f->display.x->modeline_cursor);
895 f->display.x->modeline_cursor = mode_cursor;
896 if (cross_cursor != f->display.x->cross_cursor
897 && f->display.x->cross_cursor != 0)
898 XFreeCursor (XDISPLAY f->display.x->cross_cursor);
899 f->display.x->cross_cursor = cross_cursor;
900 #endif /* HAVE_X11 */
902 XFlushQueue ();
903 UNBLOCK_INPUT;
906 void
907 x_set_cursor_color (f, arg, oldval)
908 struct frame *f;
909 Lisp_Object arg, oldval;
911 unsigned long fore_pixel;
913 if (!EQ (Vx_cursor_fore_pixel, Qnil))
914 fore_pixel = x_decode_color (Vx_cursor_fore_pixel, WHITE_PIX_DEFAULT);
915 else
916 fore_pixel = f->display.x->background_pixel;
917 f->display.x->cursor_pixel = x_decode_color (arg, BLACK_PIX_DEFAULT);
919 /* Make sure that the cursor color differs from the background color. */
920 if (f->display.x->cursor_pixel == f->display.x->background_pixel)
922 f->display.x->cursor_pixel = f->display.x->mouse_pixel;
923 if (f->display.x->cursor_pixel == fore_pixel)
924 fore_pixel = f->display.x->background_pixel;
926 f->display.x->cursor_foreground_pixel = fore_pixel;
928 if (FRAME_X_WINDOW (f) != 0)
930 #ifdef HAVE_X11
931 BLOCK_INPUT;
932 XSetBackground (x_current_display, f->display.x->cursor_gc,
933 f->display.x->cursor_pixel);
934 XSetForeground (x_current_display, f->display.x->cursor_gc,
935 fore_pixel);
936 UNBLOCK_INPUT;
937 #endif /* HAVE_X11 */
939 if (FRAME_VISIBLE_P (f))
941 x_display_cursor (f, 0);
942 x_display_cursor (f, 1);
947 /* Set the border-color of frame F to value described by ARG.
948 ARG can be a string naming a color.
949 The border-color is used for the border that is drawn by the X server.
950 Note that this does not fully take effect if done before
951 F has an x-window; it must be redone when the window is created.
953 Note: this is done in two routines because of the way X10 works.
955 Note: under X11, this is normally the province of the window manager,
956 and so emacs' border colors may be overridden. */
958 void
959 x_set_border_color (f, arg, oldval)
960 struct frame *f;
961 Lisp_Object arg, oldval;
963 unsigned char *str;
964 int pix;
966 CHECK_STRING (arg, 0);
967 str = XSTRING (arg)->data;
969 #ifndef HAVE_X11
970 if (!strcmp (str, "grey") || !strcmp (str, "Grey")
971 || !strcmp (str, "gray") || !strcmp (str, "Gray"))
972 pix = -1;
973 else
974 #endif /* X10 */
976 pix = x_decode_color (arg, BLACK_PIX_DEFAULT);
978 x_set_border_pixel (f, pix);
981 /* Set the border-color of frame F to pixel value PIX.
982 Note that this does not fully take effect if done before
983 F has an x-window. */
985 x_set_border_pixel (f, pix)
986 struct frame *f;
987 int pix;
989 f->display.x->border_pixel = pix;
991 if (FRAME_X_WINDOW (f) != 0 && f->display.x->border_width > 0)
993 Pixmap temp;
994 int mask;
996 BLOCK_INPUT;
997 #ifdef HAVE_X11
998 XSetWindowBorder (x_current_display, FRAME_X_WINDOW (f),
999 pix);
1000 #else
1001 if (pix < 0)
1002 temp = XMakePixmap ((Bitmap) XStoreBitmap (gray_width, gray_height,
1003 gray_bits),
1004 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
1005 else
1006 temp = XMakeTile (pix);
1007 XChangeBorder (FRAME_X_WINDOW (f), temp);
1008 XFreePixmap (XDISPLAY temp);
1009 #endif /* not HAVE_X11 */
1010 UNBLOCK_INPUT;
1012 if (FRAME_VISIBLE_P (f))
1013 redraw_frame (f);
1017 void
1018 x_set_cursor_type (f, arg, oldval)
1019 FRAME_PTR f;
1020 Lisp_Object arg, oldval;
1022 if (EQ (arg, Qbar))
1023 FRAME_DESIRED_CURSOR (f) = bar_cursor;
1024 else
1025 #if 0
1026 if (EQ (arg, Qbox))
1027 #endif
1028 FRAME_DESIRED_CURSOR (f) = filled_box_cursor;
1029 /* Error messages commented out because people have trouble fixing
1030 .Xdefaults with Emacs, when it has something bad in it. */
1031 #if 0
1032 else
1033 error
1034 ("the `cursor-type' frame parameter should be either `bar' or `box'");
1035 #endif
1037 /* Make sure the cursor gets redrawn. This is overkill, but how
1038 often do people change cursor types? */
1039 update_mode_lines++;
1042 void
1043 x_set_icon_type (f, arg, oldval)
1044 struct frame *f;
1045 Lisp_Object arg, oldval;
1047 Lisp_Object tem;
1048 int result;
1050 if (EQ (oldval, Qnil) == EQ (arg, Qnil))
1051 return;
1053 BLOCK_INPUT;
1054 if (NILP (arg))
1055 result = x_text_icon (f, 0);
1056 else
1057 result = x_bitmap_icon (f);
1059 if (result)
1061 UNBLOCK_INPUT;
1062 error ("No icon window available.");
1065 /* If the window was unmapped (and its icon was mapped),
1066 the new icon is not mapped, so map the window in its stead. */
1067 if (FRAME_VISIBLE_P (f))
1068 #ifdef USE_X_TOOLKIT
1069 XtPopup (f->display.x->widget, XtGrabNone);
1070 #endif
1071 XMapWindow (XDISPLAY FRAME_X_WINDOW (f));
1073 XFlushQueue ();
1074 UNBLOCK_INPUT;
1077 extern Lisp_Object x_new_font ();
1079 void
1080 x_set_font (f, arg, oldval)
1081 struct frame *f;
1082 Lisp_Object arg, oldval;
1084 Lisp_Object result;
1086 CHECK_STRING (arg, 1);
1088 BLOCK_INPUT;
1089 result = x_new_font (f, XSTRING (arg)->data);
1090 UNBLOCK_INPUT;
1092 if (EQ (result, Qnil))
1093 error ("Font \"%s\" is not defined", XSTRING (arg)->data);
1094 else if (EQ (result, Qt))
1095 error ("the characters of the given font have varying widths");
1096 else if (STRINGP (result))
1098 recompute_basic_faces (f);
1099 store_frame_param (f, Qfont, result);
1101 else
1102 abort ();
1105 void
1106 x_set_border_width (f, arg, oldval)
1107 struct frame *f;
1108 Lisp_Object arg, oldval;
1110 CHECK_NUMBER (arg, 0);
1112 if (XINT (arg) == f->display.x->border_width)
1113 return;
1115 if (FRAME_X_WINDOW (f) != 0)
1116 error ("Cannot change the border width of a window");
1118 f->display.x->border_width = XINT (arg);
1121 void
1122 x_set_internal_border_width (f, arg, oldval)
1123 struct frame *f;
1124 Lisp_Object arg, oldval;
1126 int mask;
1127 int old = f->display.x->internal_border_width;
1129 CHECK_NUMBER (arg, 0);
1130 f->display.x->internal_border_width = XINT (arg);
1131 if (f->display.x->internal_border_width < 0)
1132 f->display.x->internal_border_width = 0;
1134 if (f->display.x->internal_border_width == old)
1135 return;
1137 if (FRAME_X_WINDOW (f) != 0)
1139 BLOCK_INPUT;
1140 x_set_window_size (f, 0, f->width, f->height);
1141 #if 0
1142 x_set_resize_hint (f);
1143 #endif
1144 XFlushQueue ();
1145 UNBLOCK_INPUT;
1146 SET_FRAME_GARBAGED (f);
1150 void
1151 x_set_visibility (f, value, oldval)
1152 struct frame *f;
1153 Lisp_Object value, oldval;
1155 Lisp_Object frame;
1156 XSET (frame, Lisp_Frame, f);
1158 if (NILP (value))
1159 Fmake_frame_invisible (frame, Qt);
1160 else if (EQ (value, Qicon))
1161 Ficonify_frame (frame);
1162 else
1163 Fmake_frame_visible (frame);
1166 static void
1167 x_set_menu_bar_lines_1 (window, n)
1168 Lisp_Object window;
1169 int n;
1171 struct window *w = XWINDOW (window);
1173 XFASTINT (w->top) += n;
1174 XFASTINT (w->height) -= n;
1176 /* Handle just the top child in a vertical split. */
1177 if (!NILP (w->vchild))
1178 x_set_menu_bar_lines_1 (w->vchild, n);
1180 /* Adjust all children in a horizontal split. */
1181 for (window = w->hchild; !NILP (window); window = w->next)
1183 w = XWINDOW (window);
1184 x_set_menu_bar_lines_1 (window, n);
1188 void
1189 x_set_menu_bar_lines (f, value, oldval)
1190 struct frame *f;
1191 Lisp_Object value, oldval;
1193 int nlines;
1194 int olines = FRAME_MENU_BAR_LINES (f);
1196 /* Right now, menu bars don't work properly in minibuf-only frames;
1197 most of the commands try to apply themselves to the minibuffer
1198 frame itslef, and get an error because you can't switch buffers
1199 in or split the minibuffer window. */
1200 if (FRAME_MINIBUF_ONLY_P (f))
1201 return;
1203 if (XTYPE (value) == Lisp_Int)
1204 nlines = XINT (value);
1205 else
1206 nlines = 0;
1208 #ifdef USE_X_TOOLKIT
1209 FRAME_MENU_BAR_LINES (f) = 0;
1210 if (nlines)
1211 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1212 else
1214 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1215 free_frame_menubar (f);
1216 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1217 f->display.x->menubar_widget = 0;
1219 #else /* not USE_X_TOOLKIT */
1220 FRAME_MENU_BAR_LINES (f) = nlines;
1221 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1222 #endif /* not USE_X_TOOLKIT */
1225 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
1226 x_id_name.
1228 If EXPLICIT is non-zero, that indicates that lisp code is setting the
1229 name; if NAME is a string, set F's name to NAME and set
1230 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
1232 If EXPLICIT is zero, that indicates that Emacs redisplay code is
1233 suggesting a new name, which lisp code should override; if
1234 F->explicit_name is set, ignore the new name; otherwise, set it. */
1236 void
1237 x_set_name (f, name, explicit)
1238 struct frame *f;
1239 Lisp_Object name;
1240 int explicit;
1242 /* Make sure that requests from lisp code override requests from
1243 Emacs redisplay code. */
1244 if (explicit)
1246 /* If we're switching from explicit to implicit, we had better
1247 update the mode lines and thereby update the title. */
1248 if (f->explicit_name && NILP (name))
1249 update_mode_lines = 1;
1251 f->explicit_name = ! NILP (name);
1253 else if (f->explicit_name)
1254 return;
1256 /* If NAME is nil, set the name to the x_id_name. */
1257 if (NILP (name))
1258 name = build_string (x_id_name);
1259 else
1260 CHECK_STRING (name, 0);
1262 /* Don't change the name if it's already NAME. */
1263 if (! NILP (Fstring_equal (name, f->name)))
1264 return;
1266 if (FRAME_X_WINDOW (f))
1268 BLOCK_INPUT;
1269 #ifdef HAVE_X11R4
1271 XTextProperty text;
1272 text.value = XSTRING (name)->data;
1273 text.encoding = XA_STRING;
1274 text.format = 8;
1275 text.nitems = XSTRING (name)->size;
1276 #ifdef USE_X_TOOLKIT
1277 XSetWMName (x_current_display, XtWindow (f->display.x->widget), &text);
1278 XSetWMIconName (x_current_display, XtWindow (f->display.x->widget),
1279 &text);
1280 #else /* not USE_X_TOOLKIT */
1281 XSetWMName (x_current_display, FRAME_X_WINDOW (f), &text);
1282 XSetWMIconName (x_current_display, FRAME_X_WINDOW (f), &text);
1283 #endif /* not USE_X_TOOLKIT */
1285 #else /* not HAVE_X11R4 */
1286 XSetIconName (XDISPLAY FRAME_X_WINDOW (f),
1287 XSTRING (name)->data);
1288 XStoreName (XDISPLAY FRAME_X_WINDOW (f),
1289 XSTRING (name)->data);
1290 #endif /* not HAVE_X11R4 */
1291 UNBLOCK_INPUT;
1294 f->name = name;
1297 /* This function should be called when the user's lisp code has
1298 specified a name for the frame; the name will override any set by the
1299 redisplay code. */
1300 void
1301 x_explicitly_set_name (f, arg, oldval)
1302 FRAME_PTR f;
1303 Lisp_Object arg, oldval;
1305 x_set_name (f, arg, 1);
1308 /* This function should be called by Emacs redisplay code to set the
1309 name; names set this way will never override names set by the user's
1310 lisp code. */
1311 void
1312 x_implicitly_set_name (f, arg, oldval)
1313 FRAME_PTR f;
1314 Lisp_Object arg, oldval;
1316 x_set_name (f, arg, 0);
1319 void
1320 x_set_autoraise (f, arg, oldval)
1321 struct frame *f;
1322 Lisp_Object arg, oldval;
1324 f->auto_raise = !EQ (Qnil, arg);
1327 void
1328 x_set_autolower (f, arg, oldval)
1329 struct frame *f;
1330 Lisp_Object arg, oldval;
1332 f->auto_lower = !EQ (Qnil, arg);
1335 void
1336 x_set_vertical_scroll_bars (f, arg, oldval)
1337 struct frame *f;
1338 Lisp_Object arg, oldval;
1340 if (NILP (arg) != ! FRAME_HAS_VERTICAL_SCROLL_BARS (f))
1342 FRAME_HAS_VERTICAL_SCROLL_BARS (f) = ! NILP (arg);
1344 /* We set this parameter before creating the X window for the
1345 frame, so we can get the geometry right from the start.
1346 However, if the window hasn't been created yet, we shouldn't
1347 call x_set_window_size. */
1348 if (FRAME_X_WINDOW (f))
1349 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1353 /* Subroutines of creating an X frame. */
1355 #ifdef HAVE_X11
1357 /* Make sure that Vx_resource_name is set to a reasonable value. */
1358 static void
1359 validate_x_resource_name ()
1361 if (STRINGP (Vx_resource_name))
1363 int len = XSTRING (Vx_resource_name)->size;
1364 unsigned char *p = XSTRING (Vx_resource_name)->data;
1365 int i;
1367 /* Allow only letters, digits, - and _,
1368 because those are all that X allows. */
1369 for (i = 0; i < len; i++)
1371 int c = p[i];
1372 if (! ((c >= 'a' && c <= 'z')
1373 || (c >= 'A' && c <= 'Z')
1374 || (c >= '0' && c <= '9')
1375 || c == '-' || c == '_'))
1376 goto fail;
1379 else
1380 fail:
1381 Vx_resource_name = make_string ("emacs", 5);
1385 extern char *x_get_string_resource ();
1386 extern XrmDatabase x_load_resources ();
1388 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
1389 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
1390 This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
1391 class, where INSTANCE is the name under which Emacs was invoked, or\n\
1392 the name specified by the `-name' or `-rn' command-line arguments.\n\
1394 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
1395 class, respectively. You must specify both of them or neither.\n\
1396 If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\
1397 and the class is `Emacs.CLASS.SUBCLASS'.")
1398 (attribute, class, component, subclass)
1399 Lisp_Object attribute, class, component, subclass;
1401 register char *value;
1402 char *name_key;
1403 char *class_key;
1404 Lisp_Object resname;
1406 check_x ();
1408 CHECK_STRING (attribute, 0);
1409 CHECK_STRING (class, 0);
1411 if (!NILP (component))
1412 CHECK_STRING (component, 1);
1413 if (!NILP (subclass))
1414 CHECK_STRING (subclass, 2);
1415 if (NILP (component) != NILP (subclass))
1416 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
1418 validate_x_resource_name ();
1419 resname = Vx_resource_name;
1421 if (NILP (component))
1423 /* Allocate space for the components, the dots which separate them,
1424 and the final '\0'. */
1425 name_key = (char *) alloca (XSTRING (resname)->size
1426 + XSTRING (attribute)->size
1427 + 2);
1428 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1429 + XSTRING (class)->size
1430 + 2);
1432 sprintf (name_key, "%s.%s",
1433 XSTRING (resname)->data,
1434 XSTRING (attribute)->data);
1435 sprintf (class_key, "%s.%s",
1436 EMACS_CLASS,
1437 XSTRING (class)->data);
1439 else
1441 name_key = (char *) alloca (XSTRING (resname)->size
1442 + XSTRING (component)->size
1443 + XSTRING (attribute)->size
1444 + 3);
1446 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1447 + XSTRING (class)->size
1448 + XSTRING (subclass)->size
1449 + 3);
1451 sprintf (name_key, "%s.%s.%s",
1452 XSTRING (resname)->data,
1453 XSTRING (component)->data,
1454 XSTRING (attribute)->data);
1455 sprintf (class_key, "%s.%s.%s",
1456 EMACS_CLASS,
1457 XSTRING (class)->data,
1458 XSTRING (subclass)->data);
1461 value = x_get_string_resource (xrdb, name_key, class_key);
1463 if (value != (char *) 0)
1464 return build_string (value);
1465 else
1466 return Qnil;
1469 /* Used when C code wants a resource value. */
1471 char *
1472 x_get_resource_string (attribute, class)
1473 char *attribute, *class;
1475 register char *value;
1476 char *name_key;
1477 char *class_key;
1479 /* Allocate space for the components, the dots which separate them,
1480 and the final '\0'. */
1481 name_key = (char *) alloca (XSTRING (Vinvocation_name)->size
1482 + strlen (attribute) + 2);
1483 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
1484 + strlen (class) + 2);
1486 sprintf (name_key, "%s.%s",
1487 XSTRING (Vinvocation_name)->data,
1488 attribute);
1489 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
1491 return x_get_string_resource (xrdb, name_key, class_key);
1494 #else /* X10 */
1496 DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
1497 "Get X default ATTRIBUTE from the system, or nil if no default.\n\
1498 Value is a string (when not nil) and ATTRIBUTE is also a string.\n\
1499 The defaults are specified in the file `~/.Xdefaults'.")
1500 (arg)
1501 Lisp_Object arg;
1503 register unsigned char *value;
1505 CHECK_STRING (arg, 1);
1507 value = (unsigned char *) XGetDefault (XDISPLAY
1508 XSTRING (Vinvocation_name)->data,
1509 XSTRING (arg)->data);
1510 if (value == 0)
1511 /* Try reversing last two args, in case this is the buggy version of X. */
1512 value = (unsigned char *) XGetDefault (XDISPLAY
1513 XSTRING (arg)->data,
1514 XSTRING (Vinvocation_name)->data);
1515 if (value != 0)
1516 return build_string (value);
1517 else
1518 return (Qnil);
1521 #define Fx_get_resource(attribute, class, component, subclass) \
1522 Fx_get_default (attribute)
1524 #endif /* X10 */
1526 /* Types we might convert a resource string into. */
1527 enum resource_types
1529 number, boolean, string, symbol
1532 /* Return the value of parameter PARAM.
1534 First search ALIST, then Vdefault_frame_alist, then the X defaults
1535 database, using ATTRIBUTE as the attribute name and CLASS as its class.
1537 Convert the resource to the type specified by desired_type.
1539 If no default is specified, return Qunbound. If you call
1540 x_get_arg, make sure you deal with Qunbound in a reasonable way,
1541 and don't let it get stored in any lisp-visible variables! */
1543 static Lisp_Object
1544 x_get_arg (alist, param, attribute, class, type)
1545 Lisp_Object alist, param;
1546 char *attribute;
1547 char *class;
1548 enum resource_types type;
1550 register Lisp_Object tem;
1552 tem = Fassq (param, alist);
1553 if (EQ (tem, Qnil))
1554 tem = Fassq (param, Vdefault_frame_alist);
1555 if (EQ (tem, Qnil))
1558 if (attribute)
1560 tem = Fx_get_resource (build_string (attribute),
1561 build_string (class),
1562 Qnil, Qnil);
1564 if (NILP (tem))
1565 return Qunbound;
1567 switch (type)
1569 case number:
1570 return make_number (atoi (XSTRING (tem)->data));
1572 case boolean:
1573 tem = Fdowncase (tem);
1574 if (!strcmp (XSTRING (tem)->data, "on")
1575 || !strcmp (XSTRING (tem)->data, "true"))
1576 return Qt;
1577 else
1578 return Qnil;
1580 case string:
1581 return tem;
1583 case symbol:
1584 /* As a special case, we map the values `true' and `on'
1585 to Qt, and `false' and `off' to Qnil. */
1587 Lisp_Object lower;
1588 lower = Fdowncase (tem);
1589 if (!strcmp (XSTRING (lower)->data, "on")
1590 || !strcmp (XSTRING (lower)->data, "true"))
1591 return Qt;
1592 else if (!strcmp (XSTRING (lower)->data, "off")
1593 || !strcmp (XSTRING (lower)->data, "false"))
1594 return Qnil;
1595 else
1596 return Fintern (tem, Qnil);
1599 default:
1600 abort ();
1603 else
1604 return Qunbound;
1606 return Fcdr (tem);
1609 /* Record in frame F the specified or default value according to ALIST
1610 of the parameter named PARAM (a Lisp symbol).
1611 If no value is specified for PARAM, look for an X default for XPROP
1612 on the frame named NAME.
1613 If that is not found either, use the value DEFLT. */
1615 static Lisp_Object
1616 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
1617 struct frame *f;
1618 Lisp_Object alist;
1619 Lisp_Object prop;
1620 Lisp_Object deflt;
1621 char *xprop;
1622 char *xclass;
1623 enum resource_types type;
1625 Lisp_Object tem;
1627 tem = x_get_arg (alist, prop, xprop, xclass, type);
1628 if (EQ (tem, Qunbound))
1629 tem = deflt;
1630 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
1631 return tem;
1634 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
1635 "Parse an X-style geometry string STRING.\n\
1636 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
1637 The properties returned may include `top', `left', `height', and `width'.\n\
1638 The value of `left' or `top' may be an integer or `-'.\n\
1639 `-' means \"minus zero\".")
1640 (string)
1641 Lisp_Object string;
1643 int geometry, x, y;
1644 unsigned int width, height;
1645 Lisp_Object result;
1647 CHECK_STRING (string, 0);
1649 geometry = XParseGeometry ((char *) XSTRING (string)->data,
1650 &x, &y, &width, &height);
1652 #if 0
1653 if (!!(geometry & XValue) != !!(geometry & YValue))
1654 error ("Must specify both x and y position, or neither");
1655 #endif
1657 result = Qnil;
1658 if (geometry & XValue)
1660 Lisp_Object element;
1662 if (x == 0 && (geometry & XNegative))
1663 element = Fcons (Qleft, Qminus);
1664 else
1665 element = Fcons (Qleft, make_number (x));
1666 result = Fcons (element, result);
1669 if (geometry & YValue)
1671 Lisp_Object element;
1673 if (y == 0 && (geometry & YNegative))
1674 element = Fcons (Qtop, Qminus);
1675 else
1676 element = Fcons (Qtop, make_number (y));
1677 result = Fcons (element, result);
1680 if (geometry & WidthValue)
1681 result = Fcons (Fcons (Qwidth, make_number (width)), result);
1682 if (geometry & HeightValue)
1683 result = Fcons (Fcons (Qheight, make_number (height)), result);
1685 return result;
1688 #ifdef HAVE_X11
1689 /* Calculate the desired size and position of this window,
1690 and return the flags saying which aspects were specified.
1692 This function does not make the coordinates positive. */
1694 #define DEFAULT_ROWS 40
1695 #define DEFAULT_COLS 80
1697 static int
1698 x_figure_window_size (f, parms)
1699 struct frame *f;
1700 Lisp_Object parms;
1702 register Lisp_Object tem0, tem1, tem2;
1703 int height, width, left, top;
1704 register int geometry;
1705 long window_prompting = 0;
1707 /* Default values if we fall through.
1708 Actually, if that happens we should get
1709 window manager prompting. */
1710 f->width = DEFAULT_COLS;
1711 f->height = DEFAULT_ROWS;
1712 /* Window managers expect that if program-specified
1713 positions are not (0,0), they're intentional, not defaults. */
1714 f->display.x->top_pos = 0;
1715 f->display.x->left_pos = 0;
1717 tem0 = x_get_arg (parms, Qheight, 0, 0, number);
1718 tem1 = x_get_arg (parms, Qwidth, 0, 0, number);
1719 tem2 = x_get_arg (parms, Quser_size, 0, 0, number);
1720 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1722 if (!EQ (tem0, Qunbound))
1724 CHECK_NUMBER (tem0, 0);
1725 f->height = XINT (tem0);
1727 if (!EQ (tem1, Qunbound))
1729 CHECK_NUMBER (tem1, 0);
1730 f->width = XINT (tem1);
1732 if (!NILP (tem2) && !EQ (tem2, Qunbound))
1733 window_prompting |= USSize;
1734 else
1735 window_prompting |= PSize;
1738 f->display.x->vertical_scroll_bar_extra
1739 = (FRAME_HAS_VERTICAL_SCROLL_BARS (f)
1740 ? VERTICAL_SCROLL_BAR_PIXEL_WIDTH (f)
1741 : 0);
1742 f->display.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
1743 f->display.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
1745 tem0 = x_get_arg (parms, Qtop, 0, 0, number);
1746 tem1 = x_get_arg (parms, Qleft, 0, 0, number);
1747 tem2 = x_get_arg (parms, Quser_position, 0, 0, number);
1748 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
1750 if (EQ (tem0, Qminus))
1752 f->display.x->top_pos = 0;
1753 window_prompting |= YNegative;
1755 else if (EQ (tem0, Qunbound))
1756 f->display.x->top_pos = 0;
1757 else
1759 CHECK_NUMBER (tem0, 0);
1760 f->display.x->top_pos = XINT (tem0);
1761 if (f->display.x->top_pos < 0)
1762 window_prompting |= YNegative;
1765 if (EQ (tem1, Qminus))
1767 f->display.x->left_pos = 0;
1768 window_prompting |= XNegative;
1770 else if (EQ (tem1, Qunbound))
1771 f->display.x->left_pos = 0;
1772 else
1774 CHECK_NUMBER (tem1, 0);
1775 f->display.x->left_pos = XINT (tem1);
1776 if (f->display.x->left_pos < 0)
1777 window_prompting |= XNegative;
1780 if (!NILP (tem2))
1781 window_prompting |= USPosition;
1782 else
1783 window_prompting |= PPosition;
1786 return window_prompting;
1789 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
1791 Status
1792 XSetWMProtocols (dpy, w, protocols, count)
1793 Display *dpy;
1794 Window w;
1795 Atom *protocols;
1796 int count;
1798 Atom prop;
1799 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
1800 if (prop == None) return False;
1801 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
1802 (unsigned char *) protocols, count);
1803 return True;
1805 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
1807 #ifdef USE_X_TOOLKIT
1809 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS
1810 and WM_DELETE_WINDOW, then add them. (They may already be present
1811 because of the toolkit (Motif adds them, for example, but Xt doesn't). */
1813 static void
1814 hack_wm_protocols (widget)
1815 Widget widget;
1817 Display *dpy = XtDisplay (widget);
1818 Window w = XtWindow (widget);
1819 int need_delete = 1;
1820 int need_focus = 1;
1822 BLOCK_INPUT;
1824 Atom type, *atoms = 0;
1825 int format = 0;
1826 unsigned long nitems = 0;
1827 unsigned long bytes_after;
1829 if (Success == XGetWindowProperty (dpy, w, Xatom_wm_protocols,
1830 0, 100, False, XA_ATOM,
1831 &type, &format, &nitems, &bytes_after,
1832 (unsigned char **) &atoms)
1833 && format == 32 && type == XA_ATOM)
1834 while (nitems > 0)
1836 nitems--;
1837 if (atoms [nitems] == Xatom_wm_delete_window) need_delete = 0;
1838 else if (atoms [nitems] == Xatom_wm_take_focus) need_focus = 0;
1840 if (atoms) XFree ((char *) atoms);
1843 Atom props [10];
1844 int count = 0;
1845 if (need_delete) props [count++] = Xatom_wm_delete_window;
1846 if (need_focus) props [count++] = Xatom_wm_take_focus;
1847 if (count)
1848 XChangeProperty (dpy, w, Xatom_wm_protocols, XA_ATOM, 32, PropModeAppend,
1849 (unsigned char *) props, count);
1851 UNBLOCK_INPUT;
1853 #endif
1855 #ifdef USE_X_TOOLKIT
1857 /* Create and set up the X widget for frame F. */
1859 static void
1860 x_window (f, window_prompting, minibuffer_only)
1861 struct frame *f;
1862 long window_prompting;
1863 int minibuffer_only;
1865 XClassHint class_hints;
1866 XSetWindowAttributes attributes;
1867 unsigned long attribute_mask;
1869 Widget shell_widget;
1870 Widget pane_widget;
1871 Widget screen_widget;
1872 char* name;
1873 Arg al [25];
1874 int ac;
1876 BLOCK_INPUT;
1878 if (STRINGP (f->name))
1879 name = (char*) XSTRING (f->name)->data;
1880 else
1881 name = "emacs";
1883 ac = 0;
1884 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
1885 XtSetArg (al[ac], XtNinput, 1); ac++;
1886 shell_widget = XtCreatePopupShell ("shell",
1887 topLevelShellWidgetClass,
1888 Xt_app_shell, al, ac);
1890 f->display.x->widget = shell_widget;
1891 /* maybe_set_screen_title_format (shell_widget); */
1894 ac = 0;
1895 XtSetArg (al[ac], XtNborderWidth, 0); ac++;
1896 pane_widget = XtCreateWidget ("pane",
1897 panedWidgetClass,
1898 shell_widget, al, ac);
1900 f->display.x->column_widget = pane_widget;
1902 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
1903 initialize_frame_menubar (f);
1905 /* mappedWhenManaged to false tells to the paned window to not map/unmap
1906 the emacs screen when changing menubar. This reduces flickering. */
1908 ac = 0;
1909 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
1910 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
1911 XtSetArg (al[ac], XtNallowResize, 1); ac++;
1912 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
1913 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
1914 screen_widget = XtCreateWidget (name,
1915 emacsFrameClass,
1916 pane_widget, al, ac);
1918 f->display.x->edit_widget = screen_widget;
1920 if (f->display.x->menubar_widget)
1921 XtManageChild (f->display.x->menubar_widget);
1922 XtManageChild (screen_widget);
1924 /* Do some needed geometry management. */
1926 int len;
1927 char *tem, shell_position[32];
1928 Arg al[2];
1929 int ac = 0;
1930 int menubar_size
1931 = (f->display.x->menubar_widget
1932 ? (f->display.x->menubar_widget->core.height
1933 + f->display.x->menubar_widget->core.border_width)
1934 : 0);
1936 if (FRAME_EXTERNAL_MENU_BAR (f))
1938 Dimension ibw;
1939 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
1940 menubar_size += ibw;
1943 if (window_prompting & USPosition)
1945 int left = f->display.x->left_pos;
1946 int xneg = window_prompting & XNegative;
1947 int top = f->display.x->top_pos;
1948 int yneg = window_prompting & YNegative;
1949 if (left < 0)
1950 left = -left;
1951 if (top < 0)
1952 top = -top;
1953 sprintf (shell_position, "=%dx%d%c%d%c%d", PIXEL_WIDTH (f),
1954 PIXEL_HEIGHT (f) + menubar_size,
1955 (xneg ? '-' : '+'), left,
1956 (yneg ? '-' : '+'), top);
1958 else
1959 sprintf (shell_position, "=%dx%d", PIXEL_WIDTH (f),
1960 PIXEL_HEIGHT (f) + menubar_size);
1961 len = strlen (shell_position) + 1;
1962 tem = (char *) xmalloc (len);
1963 strncpy (tem, shell_position, len);
1964 XtSetArg (al[ac], XtNgeometry, tem); ac++;
1965 XtSetValues (shell_widget, al, ac);
1968 x_calc_absolute_position (f);
1970 XtManageChild (pane_widget);
1971 XtRealizeWidget (shell_widget);
1973 FRAME_X_WINDOW (f) = XtWindow (screen_widget);
1975 validate_x_resource_name ();
1976 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
1977 class_hints.res_class = EMACS_CLASS;
1978 XSetClassHint (x_current_display, XtWindow (shell_widget), &class_hints);
1980 f->display.x->wm_hints.input = True;
1981 f->display.x->wm_hints.flags |= InputHint;
1982 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
1984 hack_wm_protocols (shell_widget);
1986 /* Do a stupid property change to force the server to generate a
1987 propertyNotify event so that the event_stream server timestamp will
1988 be initialized to something relevant to the time we created the window.
1990 XChangeProperty (XtDisplay (screen_widget), XtWindow (screen_widget),
1991 Xatom_wm_protocols, XA_ATOM, 32, PropModeAppend,
1992 (unsigned char*) NULL, 0);
1994 /* Make all the standard events reach the Emacs frame. */
1995 attributes.event_mask = STANDARD_EVENT_SET;
1996 attribute_mask = CWEventMask;
1997 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
1998 attribute_mask, &attributes);
2000 XtMapWidget (screen_widget);
2002 /* x_set_name normally ignores requests to set the name if the
2003 requested name is the same as the current name. This is the one
2004 place where that assumption isn't correct; f->name is set, but
2005 the X server hasn't been told. */
2007 Lisp_Object name;
2008 int explicit = f->explicit_name;
2010 f->explicit_name = 0;
2011 name = f->name;
2012 f->name = Qnil;
2013 x_set_name (f, name, explicit);
2016 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
2017 f->display.x->text_cursor);
2019 UNBLOCK_INPUT;
2021 if (FRAME_X_WINDOW (f) == 0)
2022 error ("Unable to create window");
2025 #else /* not USE_X_TOOLKIT */
2027 /* Create and set up the X window for frame F. */
2029 x_window (f)
2030 struct frame *f;
2033 XClassHint class_hints;
2034 XSetWindowAttributes attributes;
2035 unsigned long attribute_mask;
2037 attributes.background_pixel = f->display.x->background_pixel;
2038 attributes.border_pixel = f->display.x->border_pixel;
2039 attributes.bit_gravity = StaticGravity;
2040 attributes.backing_store = NotUseful;
2041 attributes.save_under = True;
2042 attributes.event_mask = STANDARD_EVENT_SET;
2043 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
2044 #if 0
2045 | CWBackingStore | CWSaveUnder
2046 #endif
2047 | CWEventMask);
2049 BLOCK_INPUT;
2050 FRAME_X_WINDOW (f)
2051 = XCreateWindow (x_current_display, ROOT_WINDOW,
2052 f->display.x->left_pos,
2053 f->display.x->top_pos,
2054 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
2055 f->display.x->border_width,
2056 CopyFromParent, /* depth */
2057 InputOutput, /* class */
2058 screen_visual, /* set in Fx_open_connection */
2059 attribute_mask, &attributes);
2061 validate_x_resource_name ();
2062 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
2063 class_hints.res_class = EMACS_CLASS;
2064 XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints);
2066 /* This indicates that we use the "Passive Input" input model.
2067 Unless we do this, we don't get the Focus{In,Out} events that we
2068 need to draw the cursor correctly. Accursed bureaucrats.
2069 XWhipsAndChains (x_current_display, IronMaiden, &TheRack); */
2071 f->display.x->wm_hints.input = True;
2072 f->display.x->wm_hints.flags |= InputHint;
2073 XSetWMHints (x_current_display, FRAME_X_WINDOW (f), &f->display.x->wm_hints);
2075 /* Request "save yourself" and "delete window" commands from wm. */
2077 Atom protocols[2];
2078 protocols[0] = Xatom_wm_delete_window;
2079 protocols[1] = Xatom_wm_save_yourself;
2080 XSetWMProtocols (x_current_display, FRAME_X_WINDOW (f), protocols, 2);
2083 /* x_set_name normally ignores requests to set the name if the
2084 requested name is the same as the current name. This is the one
2085 place where that assumption isn't correct; f->name is set, but
2086 the X server hasn't been told. */
2088 Lisp_Object name;
2089 int explicit = f->explicit_name;
2091 f->explicit_name = 0;
2092 name = f->name;
2093 f->name = Qnil;
2094 x_set_name (f, name, explicit);
2097 XDefineCursor (XDISPLAY FRAME_X_WINDOW (f),
2098 f->display.x->text_cursor);
2100 UNBLOCK_INPUT;
2102 if (FRAME_X_WINDOW (f) == 0)
2103 error ("Unable to create window");
2106 #endif /* not USE_X_TOOLKIT */
2108 /* Handle the icon stuff for this window. Perhaps later we might
2109 want an x_set_icon_position which can be called interactively as
2110 well. */
2112 static void
2113 x_icon (f, parms)
2114 struct frame *f;
2115 Lisp_Object parms;
2117 Lisp_Object icon_x, icon_y;
2119 /* Set the position of the icon. Note that twm groups all
2120 icons in an icon window. */
2121 icon_x = x_get_arg (parms, Qicon_left, 0, 0, number);
2122 icon_y = x_get_arg (parms, Qicon_top, 0, 0, number);
2123 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
2125 CHECK_NUMBER (icon_x, 0);
2126 CHECK_NUMBER (icon_y, 0);
2128 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
2129 error ("Both left and top icon corners of icon must be specified");
2131 BLOCK_INPUT;
2133 if (! EQ (icon_x, Qunbound))
2134 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
2136 /* Start up iconic or window? */
2137 x_wm_set_window_state
2138 (f, (EQ (x_get_arg (parms, Qvisibility, 0, 0, symbol), Qicon)
2139 ? IconicState
2140 : NormalState));
2142 UNBLOCK_INPUT;
2145 /* Make the GC's needed for this window, setting the
2146 background, border and mouse colors; also create the
2147 mouse cursor and the gray border tile. */
2149 static char cursor_bits[] =
2151 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2152 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2153 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
2154 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
2157 static void
2158 x_make_gc (f)
2159 struct frame *f;
2161 XGCValues gc_values;
2162 GC temp_gc;
2163 XImage tileimage;
2165 BLOCK_INPUT;
2167 /* Create the GC's of this frame.
2168 Note that many default values are used. */
2170 /* Normal video */
2171 gc_values.font = f->display.x->font->fid;
2172 gc_values.foreground = f->display.x->foreground_pixel;
2173 gc_values.background = f->display.x->background_pixel;
2174 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
2175 f->display.x->normal_gc = XCreateGC (x_current_display,
2176 FRAME_X_WINDOW (f),
2177 GCLineWidth | GCFont
2178 | GCForeground | GCBackground,
2179 &gc_values);
2181 /* Reverse video style. */
2182 gc_values.foreground = f->display.x->background_pixel;
2183 gc_values.background = f->display.x->foreground_pixel;
2184 f->display.x->reverse_gc = XCreateGC (x_current_display,
2185 FRAME_X_WINDOW (f),
2186 GCFont | GCForeground | GCBackground
2187 | GCLineWidth,
2188 &gc_values);
2190 /* Cursor has cursor-color background, background-color foreground. */
2191 gc_values.foreground = f->display.x->background_pixel;
2192 gc_values.background = f->display.x->cursor_pixel;
2193 gc_values.fill_style = FillOpaqueStippled;
2194 gc_values.stipple
2195 = XCreateBitmapFromData (x_current_display, ROOT_WINDOW,
2196 cursor_bits, 16, 16);
2197 f->display.x->cursor_gc
2198 = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
2199 (GCFont | GCForeground | GCBackground
2200 | GCFillStyle | GCStipple | GCLineWidth),
2201 &gc_values);
2203 /* Create the gray border tile used when the pointer is not in
2204 the frame. Since this depends on the frame's pixel values,
2205 this must be done on a per-frame basis. */
2206 f->display.x->border_tile
2207 = (XCreatePixmapFromBitmapData
2208 (x_current_display, ROOT_WINDOW,
2209 gray_bits, gray_width, gray_height,
2210 f->display.x->foreground_pixel,
2211 f->display.x->background_pixel,
2212 DefaultDepth (x_current_display, XDefaultScreen (x_current_display))));
2214 UNBLOCK_INPUT;
2216 #endif /* HAVE_X11 */
2218 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
2219 1, 1, 0,
2220 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
2221 Return an Emacs frame object representing the X window.\n\
2222 ALIST is an alist of frame parameters.\n\
2223 If the parameters specify that the frame should not have a minibuffer,\n\
2224 and do not specify a specific minibuffer window to use,\n\
2225 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
2226 be shared by the new frame.")
2227 (parms)
2228 Lisp_Object parms;
2230 #ifdef HAVE_X11
2231 struct frame *f;
2232 Lisp_Object frame, tem;
2233 Lisp_Object name;
2234 int minibuffer_only = 0;
2235 long window_prompting = 0;
2236 int width, height;
2237 int count = specpdl_ptr - specpdl;
2239 check_x ();
2241 name = x_get_arg (parms, Qname, "title", "Title", string);
2242 if (XTYPE (name) != Lisp_String
2243 && ! EQ (name, Qunbound)
2244 && ! NILP (name))
2245 error ("x-create-frame: name parameter must be a string");
2247 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
2248 if (EQ (tem, Qnone) || NILP (tem))
2249 f = make_frame_without_minibuffer (Qnil);
2250 else if (EQ (tem, Qonly))
2252 f = make_minibuffer_frame ();
2253 minibuffer_only = 1;
2255 else if (XTYPE (tem) == Lisp_Window)
2256 f = make_frame_without_minibuffer (tem);
2257 else
2258 f = make_frame (1);
2260 /* Note that X Windows does support scroll bars. */
2261 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
2263 /* Set the name; the functions to which we pass f expect the name to
2264 be set. */
2265 if (EQ (name, Qunbound) || NILP (name))
2267 f->name = build_string (x_id_name);
2268 f->explicit_name = 0;
2270 else
2272 f->name = name;
2273 f->explicit_name = 1;
2274 /* use the frame's title when getting resources for this frame. */
2275 specbind (Qx_resource_name, name);
2278 XSET (frame, Lisp_Frame, f);
2279 f->output_method = output_x_window;
2280 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
2281 bzero (f->display.x, sizeof (struct x_display));
2283 /* Note that the frame has no physical cursor right now. */
2284 f->phys_cursor_x = -1;
2286 /* Extract the window parameters from the supplied values
2287 that are needed to determine window geometry. */
2289 Lisp_Object font;
2291 font = x_get_arg (parms, Qfont, "font", "Font", string);
2292 BLOCK_INPUT;
2293 /* First, try whatever font the caller has specified. */
2294 if (STRINGP (font))
2295 font = x_new_font (f, XSTRING (font)->data);
2296 /* Try out a font which we hope has bold and italic variations. */
2297 if (!STRINGP (font))
2298 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2299 if (! STRINGP (font))
2300 font = x_new_font (f, "-*-*-medium-r-normal-*-*-120-*-*-c-*-iso8859-1");
2301 if (! STRINGP (font))
2302 /* This was formerly the first thing tried, but it finds too many fonts
2303 and takes too long. */
2304 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
2305 /* If those didn't work, look for something which will at least work. */
2306 if (! STRINGP (font))
2307 font = x_new_font (f, "-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1");
2308 UNBLOCK_INPUT;
2309 if (! STRINGP (font))
2310 font = build_string ("fixed");
2312 x_default_parameter (f, parms, Qfont, font,
2313 "font", "Font", string);
2316 x_default_parameter (f, parms, Qborder_width, make_number (2),
2317 "borderwidth", "BorderWidth", number);
2318 /* This defaults to 2 in order to match xterm. We recognize either
2319 internalBorderWidth or internalBorder (which is what xterm calls
2320 it). */
2321 if (NILP (Fassq (Qinternal_border_width, parms)))
2323 Lisp_Object value;
2325 value = x_get_arg (parms, Qinternal_border_width,
2326 "internalBorder", "BorderWidth", number);
2327 if (! EQ (value, Qunbound))
2328 parms = Fcons (Fcons (Qinternal_border_width, value),
2329 parms);
2331 x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
2332 "internalBorderWidth", "BorderWidth", number);
2333 x_default_parameter (f, parms, Qvertical_scroll_bars, Qt,
2334 "verticalScrollBars", "ScrollBars", boolean);
2336 /* Also do the stuff which must be set before the window exists. */
2337 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
2338 "foreground", "Foreground", string);
2339 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
2340 "background", "Background", string);
2341 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
2342 "pointerColor", "Foreground", string);
2343 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
2344 "cursorColor", "Foreground", string);
2345 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
2346 "borderColor", "BorderColor", string);
2348 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (0),
2349 "menuBarLines", "MenuBarLines", number);
2351 f->display.x->parent_desc = ROOT_WINDOW;
2352 window_prompting = x_figure_window_size (f, parms);
2354 if (window_prompting & XNegative)
2356 if (window_prompting & YNegative)
2357 f->display.x->win_gravity = SouthEastGravity;
2358 else
2359 f->display.x->win_gravity = NorthEastGravity;
2361 else
2363 if (window_prompting & YNegative)
2364 f->display.x->win_gravity = SouthWestGravity;
2365 else
2366 f->display.x->win_gravity = NorthWestGravity;
2369 f->display.x->size_hint_flags = window_prompting;
2371 #ifdef USE_X_TOOLKIT
2372 x_window (f, window_prompting, minibuffer_only);
2373 #else
2374 x_window (f);
2375 #endif
2376 x_icon (f, parms);
2377 x_make_gc (f);
2378 init_frame_faces (f);
2380 /* We need to do this after creating the X window, so that the
2381 icon-creation functions can say whose icon they're describing. */
2382 x_default_parameter (f, parms, Qicon_type, Qnil,
2383 "bitmapIcon", "BitmapIcon", symbol);
2385 x_default_parameter (f, parms, Qauto_raise, Qnil,
2386 "autoRaise", "AutoRaiseLower", boolean);
2387 x_default_parameter (f, parms, Qauto_lower, Qnil,
2388 "autoLower", "AutoRaiseLower", boolean);
2389 x_default_parameter (f, parms, Qcursor_type, Qbox,
2390 "cursorType", "CursorType", symbol);
2392 /* Dimensions, especially f->height, must be done via change_frame_size.
2393 Change will not be effected unless different from the current
2394 f->height. */
2395 width = f->width;
2396 height = f->height;
2397 f->height = f->width = 0;
2398 change_frame_size (f, height, width, 1, 0);
2400 /* With the toolkit, the geometry management is done in x_window. */
2401 #ifndef USE_X_TOOLKIT
2402 BLOCK_INPUT;
2403 x_wm_set_size_hint (f, window_prompting, 0);
2404 UNBLOCK_INPUT;
2405 #endif /* USE_X_TOOLKIT */
2407 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2408 f->no_split = minibuffer_only || EQ (tem, Qt);
2410 /* It is now ok to make the frame official
2411 even if we get an error below.
2412 And the frame needs to be on Vframe_list
2413 or making it visible won't work. */
2414 Vframe_list = Fcons (frame, Vframe_list);
2416 /* Make the window appear on the frame and enable display,
2417 unless the caller says not to. */
2419 Lisp_Object visibility;
2421 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2422 if (EQ (visibility, Qunbound))
2423 visibility = Qt;
2425 if (EQ (visibility, Qicon))
2426 x_iconify_frame (f);
2427 else if (! NILP (visibility))
2428 x_make_frame_visible (f);
2429 else
2430 /* Must have been Qnil. */
2434 return unbind_to (count, frame);
2435 #else /* X10 */
2436 struct frame *f;
2437 Lisp_Object frame, tem;
2438 Lisp_Object name;
2439 int pixelwidth, pixelheight;
2440 Cursor cursor;
2441 int height, width;
2442 Window parent;
2443 Pixmap temp;
2444 int minibuffer_only = 0;
2445 Lisp_Object vscroll, hscroll;
2447 if (x_current_display == 0)
2448 error ("X windows are not in use or not initialized");
2450 name = Fassq (Qname, parms);
2452 tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol);
2453 if (EQ (tem, Qnone))
2454 f = make_frame_without_minibuffer (Qnil);
2455 else if (EQ (tem, Qonly))
2457 f = make_minibuffer_frame ();
2458 minibuffer_only = 1;
2460 else if (EQ (tem, Qnil) || EQ (tem, Qunbound))
2461 f = make_frame (1);
2462 else
2463 f = make_frame_without_minibuffer (tem);
2465 parent = ROOT_WINDOW;
2467 XSET (frame, Lisp_Frame, f);
2468 f->output_method = output_x_window;
2469 f->display.x = (struct x_display *) xmalloc (sizeof (struct x_display));
2470 bzero (f->display.x, sizeof (struct x_display));
2472 /* Some temporary default values for height and width. */
2473 width = 80;
2474 height = 40;
2475 f->display.x->left_pos = -1;
2476 f->display.x->top_pos = -1;
2478 /* Give the frame a default name (which may be overridden with PARMS). */
2480 strncpy (iconidentity, ICONTAG, MAXICID);
2481 if (gethostname (&iconidentity[sizeof (ICONTAG) - 1],
2482 (MAXICID - 1) - sizeof (ICONTAG)))
2483 iconidentity[sizeof (ICONTAG) - 2] = '\0';
2484 f->name = build_string (iconidentity);
2486 /* Extract some window parameters from the supplied values.
2487 These are the parameters that affect window geometry. */
2489 tem = x_get_arg (parms, Qfont, "BodyFont", 0, string);
2490 if (EQ (tem, Qunbound))
2491 tem = build_string ("9x15");
2492 x_set_font (f, tem, Qnil);
2493 x_default_parameter (f, parms, Qborder_color,
2494 build_string ("black"), "Border", 0, string);
2495 x_default_parameter (f, parms, Qbackground_color,
2496 build_string ("white"), "Background", 0, string);
2497 x_default_parameter (f, parms, Qforeground_color,
2498 build_string ("black"), "Foreground", 0, string);
2499 x_default_parameter (f, parms, Qmouse_color,
2500 build_string ("black"), "Mouse", 0, string);
2501 x_default_parameter (f, parms, Qcursor_color,
2502 build_string ("black"), "Cursor", 0, string);
2503 x_default_parameter (f, parms, Qborder_width,
2504 make_number (2), "BorderWidth", 0, number);
2505 x_default_parameter (f, parms, Qinternal_border_width,
2506 make_number (4), "InternalBorderWidth", 0, number);
2507 x_default_parameter (f, parms, Qauto_raise,
2508 Qnil, "AutoRaise", 0, boolean);
2510 hscroll = EQ (x_get_arg (parms, Qhorizontal_scroll_bar, 0, 0, boolean), Qt);
2511 vscroll = EQ (x_get_arg (parms, Qvertical_scroll_bar, 0, 0, boolean), Qt);
2513 if (f->display.x->internal_border_width < 0)
2514 f->display.x->internal_border_width = 0;
2516 tem = x_get_arg (parms, Qwindow_id, 0, 0, number);
2517 if (!EQ (tem, Qunbound))
2519 WINDOWINFO_TYPE wininfo;
2520 int nchildren;
2521 Window *children, root;
2523 CHECK_NUMBER (tem, 0);
2524 FRAME_X_WINDOW (f) = (Window) XINT (tem);
2526 BLOCK_INPUT;
2527 XGetWindowInfo (FRAME_X_WINDOW (f), &wininfo);
2528 XQueryTree (FRAME_X_WINDOW (f), &parent, &nchildren, &children);
2529 xfree (children);
2530 UNBLOCK_INPUT;
2532 height = PIXEL_TO_CHAR_HEIGHT (f, wininfo.height);
2533 width = PIXEL_TO_CHAR_WIDTH (f, wininfo.width);
2534 f->display.x->left_pos = wininfo.x;
2535 f->display.x->top_pos = wininfo.y;
2536 FRAME_SET_VISIBILITY (f, wininfo.mapped != 0);
2537 f->display.x->border_width = wininfo.bdrwidth;
2538 f->display.x->parent_desc = parent;
2540 else
2542 tem = x_get_arg (parms, Qparent_id, 0, 0, number);
2543 if (!EQ (tem, Qunbound))
2545 CHECK_NUMBER (tem, 0);
2546 parent = (Window) XINT (tem);
2548 f->display.x->parent_desc = parent;
2549 tem = x_get_arg (parms, Qheight, 0, 0, number);
2550 if (EQ (tem, Qunbound))
2552 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2553 if (EQ (tem, Qunbound))
2555 tem = x_get_arg (parms, Qtop, 0, 0, number);
2556 if (EQ (tem, Qunbound))
2557 tem = x_get_arg (parms, Qleft, 0, 0, number);
2560 /* Now TEM is Qunbound if no edge or size was specified.
2561 In that case, we must do rubber-banding. */
2562 if (EQ (tem, Qunbound))
2564 tem = x_get_arg (parms, Qgeometry, 0, 0, number);
2565 x_rubber_band (f,
2566 &f->display.x->left_pos, &f->display.x->top_pos,
2567 &width, &height,
2568 (XTYPE (tem) == Lisp_String
2569 ? (char *) XSTRING (tem)->data : ""),
2570 XSTRING (f->name)->data,
2571 !NILP (hscroll), !NILP (vscroll));
2573 else
2575 /* Here if at least one edge or size was specified.
2576 Demand that they all were specified, and use them. */
2577 tem = x_get_arg (parms, Qheight, 0, 0, number);
2578 if (EQ (tem, Qunbound))
2579 error ("Height not specified");
2580 CHECK_NUMBER (tem, 0);
2581 height = XINT (tem);
2583 tem = x_get_arg (parms, Qwidth, 0, 0, number);
2584 if (EQ (tem, Qunbound))
2585 error ("Width not specified");
2586 CHECK_NUMBER (tem, 0);
2587 width = XINT (tem);
2589 tem = x_get_arg (parms, Qtop, 0, 0, number);
2590 if (EQ (tem, Qunbound))
2591 error ("Top position not specified");
2592 CHECK_NUMBER (tem, 0);
2593 f->display.x->left_pos = XINT (tem);
2595 tem = x_get_arg (parms, Qleft, 0, 0, number);
2596 if (EQ (tem, Qunbound))
2597 error ("Left position not specified");
2598 CHECK_NUMBER (tem, 0);
2599 f->display.x->top_pos = XINT (tem);
2602 pixelwidth = CHAR_TO_PIXEL_WIDTH (f, width);
2603 pixelheight = CHAR_TO_PIXEL_HEIGHT (f, height);
2605 BLOCK_INPUT;
2606 FRAME_X_WINDOW (f)
2607 = XCreateWindow (parent,
2608 f->display.x->left_pos, /* Absolute horizontal offset */
2609 f->display.x->top_pos, /* Absolute Vertical offset */
2610 pixelwidth, pixelheight,
2611 f->display.x->border_width,
2612 BLACK_PIX_DEFAULT, WHITE_PIX_DEFAULT);
2613 UNBLOCK_INPUT;
2614 if (FRAME_X_WINDOW (f) == 0)
2615 error ("Unable to create window.");
2618 /* Install the now determined height and width
2619 in the windows and in phys_lines and desired_lines. */
2620 change_frame_size (f, height, width, 1, 0);
2621 XSelectInput (FRAME_X_WINDOW (f), KeyPressed | ExposeWindow
2622 | ButtonPressed | ButtonReleased | ExposeRegion | ExposeCopy
2623 | EnterWindow | LeaveWindow | UnmapWindow );
2624 x_set_resize_hint (f);
2626 /* Tell the server the window's default name. */
2627 XStoreName (XDISPLAY FRAME_X_WINDOW (f), XSTRING (f->name)->data);
2629 /* Now override the defaults with all the rest of the specified
2630 parms. */
2631 tem = x_get_arg (parms, Qunsplittable, 0, 0, boolean);
2632 f->no_split = minibuffer_only || EQ (tem, Qt);
2634 /* Do not create an icon window if the caller says not to */
2635 if (!EQ (x_get_arg (parms, Qsuppress_icon, 0, 0, boolean), Qt)
2636 || f->display.x->parent_desc != ROOT_WINDOW)
2638 x_text_icon (f, iconidentity);
2639 x_default_parameter (f, parms, Qicon_type, Qnil,
2640 "BitmapIcon", 0, symbol);
2643 /* Tell the X server the previously set values of the
2644 background, border and mouse colors; also create the mouse cursor. */
2645 BLOCK_INPUT;
2646 temp = XMakeTile (f->display.x->background_pixel);
2647 XChangeBackground (FRAME_X_WINDOW (f), temp);
2648 XFreePixmap (temp);
2649 UNBLOCK_INPUT;
2650 x_set_border_pixel (f, f->display.x->border_pixel);
2652 x_set_mouse_color (f, Qnil, Qnil);
2654 /* Now override the defaults with all the rest of the specified parms. */
2656 Fmodify_frame_parameters (frame, parms);
2658 /* Make the window appear on the frame and enable display. */
2660 Lisp_Object visibility;
2662 visibility = x_get_arg (parms, Qvisibility, 0, 0, symbol);
2663 if (EQ (visibility, Qunbound))
2664 visibility = Qt;
2666 if (! EQ (visibility, Qicon)
2667 && ! NILP (visibility))
2668 x_make_window_visible (f);
2671 SET_FRAME_GARBAGED (f);
2673 Vframe_list = Fcons (frame, Vframe_list);
2674 return frame;
2675 #endif /* X10 */
2678 Lisp_Object
2679 x_get_focus_frame ()
2681 Lisp_Object xfocus;
2682 if (! x_focus_frame)
2683 return Qnil;
2685 XSET (xfocus, Lisp_Frame, x_focus_frame);
2686 return xfocus;
2689 DEFUN ("focus-frame", Ffocus_frame, Sfocus_frame, 1, 1, 0,
2690 "Set the focus on FRAME.")
2691 (frame)
2692 Lisp_Object frame;
2694 CHECK_LIVE_FRAME (frame, 0);
2696 if (FRAME_X_P (XFRAME (frame)))
2698 BLOCK_INPUT;
2699 x_focus_on_frame (XFRAME (frame));
2700 UNBLOCK_INPUT;
2701 return frame;
2704 return Qnil;
2707 DEFUN ("unfocus-frame", Funfocus_frame, Sunfocus_frame, 0, 0, 0,
2708 "If a frame has been focused, release it.")
2711 if (x_focus_frame)
2713 BLOCK_INPUT;
2714 x_unfocus_frame (x_focus_frame);
2715 UNBLOCK_INPUT;
2718 return Qnil;
2721 #ifndef HAVE_X11
2722 /* Computes an X-window size and position either from geometry GEO
2723 or with the mouse.
2725 F is a frame. It specifies an X window which is used to
2726 determine which display to compute for. Its font, borders
2727 and colors control how the rectangle will be displayed.
2729 X and Y are where to store the positions chosen.
2730 WIDTH and HEIGHT are where to store the sizes chosen.
2732 GEO is the geometry that may specify some of the info.
2733 STR is a prompt to display.
2734 HSCROLL and VSCROLL say whether we have horiz and vert scroll bars. */
2737 x_rubber_band (f, x, y, width, height, geo, str, hscroll, vscroll)
2738 struct frame *f;
2739 int *x, *y, *width, *height;
2740 char *geo;
2741 char *str;
2742 int hscroll, vscroll;
2744 OpaqueFrame frame;
2745 Window tempwindow;
2746 WindowInfo wininfo;
2747 int border_color;
2748 int background_color;
2749 Lisp_Object tem;
2750 int mask;
2752 BLOCK_INPUT;
2754 background_color = f->display.x->background_pixel;
2755 border_color = f->display.x->border_pixel;
2757 frame.bdrwidth = f->display.x->border_width;
2758 frame.border = XMakeTile (border_color);
2759 frame.background = XMakeTile (background_color);
2760 tempwindow = XCreateTerm (str, "emacs", geo, default_window, &frame, 10, 5,
2761 (2 * f->display.x->internal_border_width
2762 + (vscroll ? VSCROLL_WIDTH : 0)),
2763 (2 * f->display.x->internal_border_width
2764 + (hscroll ? HSCROLL_HEIGHT : 0)),
2765 width, height, f->display.x->font,
2766 FONT_WIDTH (f->display.x->font),
2767 f->display.x->line_height);
2768 XFreePixmap (frame.border);
2769 XFreePixmap (frame.background);
2771 if (tempwindow != 0)
2773 XQueryWindow (tempwindow, &wininfo);
2774 XDestroyWindow (tempwindow);
2775 *x = wininfo.x;
2776 *y = wininfo.y;
2779 /* Coordinates we got are relative to the root window.
2780 Convert them to coordinates relative to desired parent window
2781 by scanning from there up to the root. */
2782 tempwindow = f->display.x->parent_desc;
2783 while (tempwindow != ROOT_WINDOW)
2785 int nchildren;
2786 Window *children;
2787 XQueryWindow (tempwindow, &wininfo);
2788 *x -= wininfo.x;
2789 *y -= wininfo.y;
2790 XQueryTree (tempwindow, &tempwindow, &nchildren, &children);
2791 xfree (children);
2794 UNBLOCK_INPUT;
2795 return tempwindow != 0;
2797 #endif /* not HAVE_X11 */
2799 DEFUN ("x-list-fonts", Fx_list_fonts, Sx_list_fonts, 1, 3, 0,
2800 "Return a list of the names of available fonts matching PATTERN.\n\
2801 If optional arguments FACE and FRAME are specified, return only fonts\n\
2802 the same size as FACE on FRAME.\n\
2804 PATTERN is a string, perhaps with wildcard characters;\n\
2805 the * character matches any substring, and\n\
2806 the ? character matches any single character.\n\
2807 PATTERN is case-insensitive.\n\
2808 FACE is a face name - a symbol.\n\
2810 The return value is a list of strings, suitable as arguments to\n\
2811 set-face-font.\n\
2813 Fonts Emacs can't use (i.e. proportional fonts) may or may not be excluded\n\
2814 even if they match PATTERN and FACE.")
2815 (pattern, face, frame)
2816 Lisp_Object pattern, face, frame;
2818 int num_fonts;
2819 char **names;
2820 XFontStruct *info;
2821 XFontStruct *size_ref;
2822 Lisp_Object list;
2824 check_x ();
2825 CHECK_STRING (pattern, 0);
2826 if (!NILP (face))
2827 CHECK_SYMBOL (face, 1);
2828 if (!NILP (frame))
2829 CHECK_LIVE_FRAME (frame, 2);
2831 if (NILP (face))
2832 size_ref = 0;
2833 else
2835 FRAME_PTR f = NILP (frame) ? selected_frame : XFRAME (frame);
2836 int face_id;
2838 /* Don't die if we get called with a terminal frame. */
2839 if (! FRAME_X_P (f))
2840 error ("non-X frame used in `x-list-fonts'");
2842 face_id = face_name_id_number (f, face);
2844 if (face_id < 0 || face_id >= FRAME_N_PARAM_FACES (f)
2845 || FRAME_PARAM_FACES (f) [face_id] == 0)
2846 size_ref = f->display.x->font;
2847 else
2849 size_ref = FRAME_PARAM_FACES (f) [face_id]->font;
2850 if (size_ref == (XFontStruct *) (~0))
2851 size_ref = f->display.x->font;
2855 BLOCK_INPUT;
2857 /* Solaris 2.3 has a bug in XListFontsWithInfo. */
2858 #ifdef BROKEN_XLISTFONTSWITHINFO
2859 names = XListFonts (x_current_display,
2860 XSTRING (pattern)->data,
2861 2000, /* maxnames */
2862 &num_fonts); /* count_return */
2863 #else
2864 names = XListFontsWithInfo (x_current_display,
2865 XSTRING (pattern)->data,
2866 2000, /* maxnames */
2867 &num_fonts, /* count_return */
2868 &info); /* info_return */
2869 #endif
2870 UNBLOCK_INPUT;
2872 list = Qnil;
2874 if (names)
2876 Lisp_Object *tail;
2877 int i;
2879 tail = &list;
2880 for (i = 0; i < num_fonts; i++)
2882 XFontStruct *thisinfo;
2884 #ifdef BROKEN_XLISTFONTSWITHINFO
2885 BLOCK_INPUT;
2886 thisinfo = XLoadQueryFont (x_current_display, names[i]);
2887 UNBLOCK_INPUT;
2888 #else
2889 thisinfo = &info[i];
2890 #endif
2891 if (thisinfo && (! size_ref
2892 || same_size_fonts (thisinfo, size_ref)))
2894 *tail = Fcons (build_string (names[i]), Qnil);
2895 tail = &XCONS (*tail)->cdr;
2899 BLOCK_INPUT;
2900 #ifdef BROKEN_XLISTFONTSWITHINFO
2901 XFreeFontNames (names);
2902 #else
2903 XFreeFontInfo (names, info, num_fonts);
2904 #endif
2905 UNBLOCK_INPUT;
2908 return list;
2912 DEFUN ("x-color-defined-p", Fx_color_defined_p, Sx_color_defined_p, 1, 1, 0,
2913 "Return t if the current X display supports the color named COLOR.")
2914 (color)
2915 Lisp_Object color;
2917 Color foo;
2919 check_x ();
2920 CHECK_STRING (color, 0);
2922 if (defined_color (XSTRING (color)->data, &foo))
2923 return Qt;
2924 else
2925 return Qnil;
2928 DEFUN ("x-display-color-p", Fx_display_color_p, Sx_display_color_p, 0, 0, 0,
2929 "Return t if the X screen currently in use supports color.")
2932 check_x ();
2934 if (x_screen_planes <= 2)
2935 return Qnil;
2937 switch (screen_visual->class)
2939 case StaticColor:
2940 case PseudoColor:
2941 case TrueColor:
2942 case DirectColor:
2943 return Qt;
2945 default:
2946 return Qnil;
2950 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
2951 0, 1, 0,
2952 "Returns the width in pixels of the display FRAME is on.")
2953 (frame)
2954 Lisp_Object frame;
2956 Display *dpy = x_current_display;
2957 check_x ();
2958 return make_number (DisplayWidth (dpy, DefaultScreen (dpy)));
2961 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
2962 Sx_display_pixel_height, 0, 1, 0,
2963 "Returns the height in pixels of the display FRAME is on.")
2964 (frame)
2965 Lisp_Object frame;
2967 Display *dpy = x_current_display;
2968 check_x ();
2969 return make_number (DisplayHeight (dpy, DefaultScreen (dpy)));
2972 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
2973 0, 1, 0,
2974 "Returns the number of bitplanes of the display FRAME is on.")
2975 (frame)
2976 Lisp_Object frame;
2978 Display *dpy = x_current_display;
2979 check_x ();
2980 return make_number (DisplayPlanes (dpy, DefaultScreen (dpy)));
2983 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
2984 0, 1, 0,
2985 "Returns the number of color cells of the display FRAME is on.")
2986 (frame)
2987 Lisp_Object frame;
2989 Display *dpy = x_current_display;
2990 check_x ();
2991 return make_number (DisplayCells (dpy, DefaultScreen (dpy)));
2994 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
2995 Sx_server_max_request_size,
2996 0, 1, 0,
2997 "Returns the maximum request size of the X server FRAME is using.")
2998 (frame)
2999 Lisp_Object frame;
3001 Display *dpy = x_current_display;
3002 check_x ();
3003 return make_number (MAXREQUEST (dpy));
3006 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
3007 "Returns the vendor ID string of the X server FRAME is on.")
3008 (frame)
3009 Lisp_Object frame;
3011 Display *dpy = x_current_display;
3012 char *vendor;
3013 check_x ();
3014 vendor = ServerVendor (dpy);
3015 if (! vendor) vendor = "";
3016 return build_string (vendor);
3019 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
3020 "Returns the version numbers of the X server in use.\n\
3021 The value is a list of three integers: the major and minor\n\
3022 version numbers of the X Protocol in use, and the vendor-specific release\n\
3023 number. See also the variable `x-server-vendor'.")
3024 (frame)
3025 Lisp_Object frame;
3027 Display *dpy = x_current_display;
3029 check_x ();
3030 return Fcons (make_number (ProtocolVersion (dpy)),
3031 Fcons (make_number (ProtocolRevision (dpy)),
3032 Fcons (make_number (VendorRelease (dpy)), Qnil)));
3035 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
3036 "Returns the number of screens on the X server FRAME is on.")
3037 (frame)
3038 Lisp_Object frame;
3040 check_x ();
3041 return make_number (ScreenCount (x_current_display));
3044 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
3045 "Returns the height in millimeters of the X screen FRAME is on.")
3046 (frame)
3047 Lisp_Object frame;
3049 check_x ();
3050 return make_number (HeightMMOfScreen (x_screen));
3053 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
3054 "Returns the width in millimeters of the X screen FRAME is on.")
3055 (frame)
3056 Lisp_Object frame;
3058 check_x ();
3059 return make_number (WidthMMOfScreen (x_screen));
3062 DEFUN ("x-display-backing-store", Fx_display_backing_store,
3063 Sx_display_backing_store, 0, 1, 0,
3064 "Returns an indication of whether the X screen FRAME is on does backing store.\n\
3065 The value may be `always', `when-mapped', or `not-useful'.")
3066 (frame)
3067 Lisp_Object frame;
3069 check_x ();
3071 switch (DoesBackingStore (x_screen))
3073 case Always:
3074 return intern ("always");
3076 case WhenMapped:
3077 return intern ("when-mapped");
3079 case NotUseful:
3080 return intern ("not-useful");
3082 default:
3083 error ("Strange value for BackingStore parameter of screen");
3087 DEFUN ("x-display-visual-class", Fx_display_visual_class,
3088 Sx_display_visual_class, 0, 1, 0,
3089 "Returns the visual class of the display `screen' is on.\n\
3090 The value is one of the symbols `static-gray', `gray-scale',\n\
3091 `static-color', `pseudo-color', `true-color', or `direct-color'.")
3092 (screen)
3093 Lisp_Object screen;
3095 check_x ();
3097 switch (screen_visual->class)
3099 case StaticGray: return (intern ("static-gray"));
3100 case GrayScale: return (intern ("gray-scale"));
3101 case StaticColor: return (intern ("static-color"));
3102 case PseudoColor: return (intern ("pseudo-color"));
3103 case TrueColor: return (intern ("true-color"));
3104 case DirectColor: return (intern ("direct-color"));
3105 default:
3106 error ("Display has an unknown visual class");
3110 DEFUN ("x-display-save-under", Fx_display_save_under,
3111 Sx_display_save_under, 0, 1, 0,
3112 "Returns t if the X screen FRAME is on supports the save-under feature.")
3113 (frame)
3114 Lisp_Object frame;
3116 check_x ();
3118 if (DoesSaveUnders (x_screen) == True)
3119 return Qt;
3120 else
3121 return Qnil;
3124 x_pixel_width (f)
3125 register struct frame *f;
3127 return PIXEL_WIDTH (f);
3130 x_pixel_height (f)
3131 register struct frame *f;
3133 return PIXEL_HEIGHT (f);
3136 x_char_width (f)
3137 register struct frame *f;
3139 return FONT_WIDTH (f->display.x->font);
3142 x_char_height (f)
3143 register struct frame *f;
3145 return f->display.x->line_height;
3148 #if 0 /* These no longer seem like the right way to do things. */
3150 /* Draw a rectangle on the frame with left top corner including
3151 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
3152 CHARS by LINES wide and long and is the color of the cursor. */
3154 void
3155 x_rectangle (f, gc, left_char, top_char, chars, lines)
3156 register struct frame *f;
3157 GC gc;
3158 register int top_char, left_char, chars, lines;
3160 int width;
3161 int height;
3162 int left = (left_char * FONT_WIDTH (f->display.x->font)
3163 + f->display.x->internal_border_width);
3164 int top = (top_char * f->display.x->line_height
3165 + f->display.x->internal_border_width);
3167 if (chars < 0)
3168 width = FONT_WIDTH (f->display.x->font) / 2;
3169 else
3170 width = FONT_WIDTH (f->display.x->font) * chars;
3171 if (lines < 0)
3172 height = f->display.x->line_height / 2;
3173 else
3174 height = f->display.x->line_height * lines;
3176 XDrawRectangle (x_current_display, FRAME_X_WINDOW (f),
3177 gc, left, top, width, height);
3180 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
3181 "Draw a rectangle on FRAME between coordinates specified by\n\
3182 numbers X0, Y0, X1, Y1 in the cursor pixel.")
3183 (frame, X0, Y0, X1, Y1)
3184 register Lisp_Object frame, X0, X1, Y0, Y1;
3186 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3188 CHECK_LIVE_FRAME (frame, 0);
3189 CHECK_NUMBER (X0, 0);
3190 CHECK_NUMBER (Y0, 1);
3191 CHECK_NUMBER (X1, 2);
3192 CHECK_NUMBER (Y1, 3);
3194 x0 = XINT (X0);
3195 x1 = XINT (X1);
3196 y0 = XINT (Y0);
3197 y1 = XINT (Y1);
3199 if (y1 > y0)
3201 top = y0;
3202 n_lines = y1 - y0 + 1;
3204 else
3206 top = y1;
3207 n_lines = y0 - y1 + 1;
3210 if (x1 > x0)
3212 left = x0;
3213 n_chars = x1 - x0 + 1;
3215 else
3217 left = x1;
3218 n_chars = x0 - x1 + 1;
3221 BLOCK_INPUT;
3222 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->cursor_gc,
3223 left, top, n_chars, n_lines);
3224 UNBLOCK_INPUT;
3226 return Qt;
3229 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
3230 "Draw a rectangle drawn on FRAME between coordinates\n\
3231 X0, Y0, X1, Y1 in the regular background-pixel.")
3232 (frame, X0, Y0, X1, Y1)
3233 register Lisp_Object frame, X0, Y0, X1, Y1;
3235 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
3237 CHECK_FRAME (frame, 0);
3238 CHECK_NUMBER (X0, 0);
3239 CHECK_NUMBER (Y0, 1);
3240 CHECK_NUMBER (X1, 2);
3241 CHECK_NUMBER (Y1, 3);
3243 x0 = XINT (X0);
3244 x1 = XINT (X1);
3245 y0 = XINT (Y0);
3246 y1 = XINT (Y1);
3248 if (y1 > y0)
3250 top = y0;
3251 n_lines = y1 - y0 + 1;
3253 else
3255 top = y1;
3256 n_lines = y0 - y1 + 1;
3259 if (x1 > x0)
3261 left = x0;
3262 n_chars = x1 - x0 + 1;
3264 else
3266 left = x1;
3267 n_chars = x0 - x1 + 1;
3270 BLOCK_INPUT;
3271 x_rectangle (XFRAME (frame), XFRAME (frame)->display.x->reverse_gc,
3272 left, top, n_chars, n_lines);
3273 UNBLOCK_INPUT;
3275 return Qt;
3278 /* Draw lines around the text region beginning at the character position
3279 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
3280 pixel and line characteristics. */
3282 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
3284 static void
3285 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
3286 register struct frame *f;
3287 GC gc;
3288 int top_x, top_y, bottom_x, bottom_y;
3290 register int ibw = f->display.x->internal_border_width;
3291 register int font_w = FONT_WIDTH (f->display.x->font);
3292 register int font_h = f->display.x->line_height;
3293 int y = top_y;
3294 int x = line_len (y);
3295 XPoint *pixel_points
3296 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
3297 register XPoint *this_point = pixel_points;
3299 /* Do the horizontal top line/lines */
3300 if (top_x == 0)
3302 this_point->x = ibw;
3303 this_point->y = ibw + (font_h * top_y);
3304 this_point++;
3305 if (x == 0)
3306 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
3307 else
3308 this_point->x = ibw + (font_w * x);
3309 this_point->y = (this_point - 1)->y;
3311 else
3313 this_point->x = ibw;
3314 this_point->y = ibw + (font_h * (top_y + 1));
3315 this_point++;
3316 this_point->x = ibw + (font_w * top_x);
3317 this_point->y = (this_point - 1)->y;
3318 this_point++;
3319 this_point->x = (this_point - 1)->x;
3320 this_point->y = ibw + (font_h * top_y);
3321 this_point++;
3322 this_point->x = ibw + (font_w * x);
3323 this_point->y = (this_point - 1)->y;
3326 /* Now do the right side. */
3327 while (y < bottom_y)
3328 { /* Right vertical edge */
3329 this_point++;
3330 this_point->x = (this_point - 1)->x;
3331 this_point->y = ibw + (font_h * (y + 1));
3332 this_point++;
3334 y++; /* Horizontal connection to next line */
3335 x = line_len (y);
3336 if (x == 0)
3337 this_point->x = ibw + (font_w / 2);
3338 else
3339 this_point->x = ibw + (font_w * x);
3341 this_point->y = (this_point - 1)->y;
3344 /* Now do the bottom and connect to the top left point. */
3345 this_point->x = ibw + (font_w * (bottom_x + 1));
3347 this_point++;
3348 this_point->x = (this_point - 1)->x;
3349 this_point->y = ibw + (font_h * (bottom_y + 1));
3350 this_point++;
3351 this_point->x = ibw;
3352 this_point->y = (this_point - 1)->y;
3353 this_point++;
3354 this_point->x = pixel_points->x;
3355 this_point->y = pixel_points->y;
3357 XDrawLines (x_current_display, FRAME_X_WINDOW (f),
3358 gc, pixel_points,
3359 (this_point - pixel_points + 1), CoordModeOrigin);
3362 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
3363 "Highlight the region between point and the character under the mouse\n\
3364 selected frame.")
3365 (event)
3366 register Lisp_Object event;
3368 register int x0, y0, x1, y1;
3369 register struct frame *f = selected_frame;
3370 register int p1, p2;
3372 CHECK_CONS (event, 0);
3374 BLOCK_INPUT;
3375 x0 = XINT (Fcar (Fcar (event)));
3376 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3378 /* If the mouse is past the end of the line, don't that area. */
3379 /* ReWrite this... */
3381 x1 = f->cursor_x;
3382 y1 = f->cursor_y;
3384 if (y1 > y0) /* point below mouse */
3385 outline_region (f, f->display.x->cursor_gc,
3386 x0, y0, x1, y1);
3387 else if (y1 < y0) /* point above mouse */
3388 outline_region (f, f->display.x->cursor_gc,
3389 x1, y1, x0, y0);
3390 else /* same line: draw horizontal rectangle */
3392 if (x1 > x0)
3393 x_rectangle (f, f->display.x->cursor_gc,
3394 x0, y0, (x1 - x0 + 1), 1);
3395 else if (x1 < x0)
3396 x_rectangle (f, f->display.x->cursor_gc,
3397 x1, y1, (x0 - x1 + 1), 1);
3400 XFlush (x_current_display);
3401 UNBLOCK_INPUT;
3403 return Qnil;
3406 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
3407 "Erase any highlighting of the region between point and the character\n\
3408 at X, Y on the selected frame.")
3409 (event)
3410 register Lisp_Object event;
3412 register int x0, y0, x1, y1;
3413 register struct frame *f = selected_frame;
3415 BLOCK_INPUT;
3416 x0 = XINT (Fcar (Fcar (event)));
3417 y0 = XINT (Fcar (Fcdr (Fcar (event))));
3418 x1 = f->cursor_x;
3419 y1 = f->cursor_y;
3421 if (y1 > y0) /* point below mouse */
3422 outline_region (f, f->display.x->reverse_gc,
3423 x0, y0, x1, y1);
3424 else if (y1 < y0) /* point above mouse */
3425 outline_region (f, f->display.x->reverse_gc,
3426 x1, y1, x0, y0);
3427 else /* same line: draw horizontal rectangle */
3429 if (x1 > x0)
3430 x_rectangle (f, f->display.x->reverse_gc,
3431 x0, y0, (x1 - x0 + 1), 1);
3432 else if (x1 < x0)
3433 x_rectangle (f, f->display.x->reverse_gc,
3434 x1, y1, (x0 - x1 + 1), 1);
3436 UNBLOCK_INPUT;
3438 return Qnil;
3441 #if 0
3442 int contour_begin_x, contour_begin_y;
3443 int contour_end_x, contour_end_y;
3444 int contour_npoints;
3446 /* Clip the top part of the contour lines down (and including) line Y_POS.
3447 If X_POS is in the middle (rather than at the end) of the line, drop
3448 down a line at that character. */
3450 static void
3451 clip_contour_top (y_pos, x_pos)
3453 register XPoint *begin = contour_lines[y_pos].top_left;
3454 register XPoint *end;
3455 register int npoints;
3456 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
3458 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
3460 end = contour_lines[y_pos].top_right;
3461 npoints = (end - begin + 1);
3462 XDrawLines (x_current_display, contour_window,
3463 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3465 bcopy (end, begin + 1, contour_last_point - end + 1);
3466 contour_last_point -= (npoints - 2);
3467 XDrawLines (x_current_display, contour_window,
3468 contour_erase_gc, begin, 2, CoordModeOrigin);
3469 XFlush (x_current_display);
3471 /* Now, update contour_lines structure. */
3473 /* ______. */
3474 else /* |________*/
3476 register XPoint *p = begin + 1;
3477 end = contour_lines[y_pos].bottom_right;
3478 npoints = (end - begin + 1);
3479 XDrawLines (x_current_display, contour_window,
3480 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
3482 p->y = begin->y;
3483 p->x = ibw + (font_w * (x_pos + 1));
3484 p++;
3485 p->y = begin->y + font_h;
3486 p->x = (p - 1)->x;
3487 bcopy (end, begin + 3, contour_last_point - end + 1);
3488 contour_last_point -= (npoints - 5);
3489 XDrawLines (x_current_display, contour_window,
3490 contour_erase_gc, begin, 4, CoordModeOrigin);
3491 XFlush (x_current_display);
3493 /* Now, update contour_lines structure. */
3497 /* Erase the top horizontal lines of the contour, and then extend
3498 the contour upwards. */
3500 static void
3501 extend_contour_top (line)
3505 static void
3506 clip_contour_bottom (x_pos, y_pos)
3507 int x_pos, y_pos;
3511 static void
3512 extend_contour_bottom (x_pos, y_pos)
3516 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
3518 (event)
3519 Lisp_Object event;
3521 register struct frame *f = selected_frame;
3522 register int point_x = f->cursor_x;
3523 register int point_y = f->cursor_y;
3524 register int mouse_below_point;
3525 register Lisp_Object obj;
3526 register int x_contour_x, x_contour_y;
3528 x_contour_x = x_mouse_x;
3529 x_contour_y = x_mouse_y;
3530 if (x_contour_y > point_y || (x_contour_y == point_y
3531 && x_contour_x > point_x))
3533 mouse_below_point = 1;
3534 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
3535 x_contour_x, x_contour_y);
3537 else
3539 mouse_below_point = 0;
3540 outline_region (f, f->display.x->cursor_gc, x_contour_x, x_contour_y,
3541 point_x, point_y);
3544 while (1)
3546 obj = read_char (-1, 0, 0, Qnil, 0);
3547 if (XTYPE (obj) != Lisp_Cons)
3548 break;
3550 if (mouse_below_point)
3552 if (x_mouse_y <= point_y) /* Flipped. */
3554 mouse_below_point = 0;
3556 outline_region (f, f->display.x->reverse_gc, point_x, point_y,
3557 x_contour_x, x_contour_y);
3558 outline_region (f, f->display.x->cursor_gc, x_mouse_x, x_mouse_y,
3559 point_x, point_y);
3561 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
3563 clip_contour_bottom (x_mouse_y);
3565 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
3567 extend_bottom_contour (x_mouse_y);
3570 x_contour_x = x_mouse_x;
3571 x_contour_y = x_mouse_y;
3573 else /* mouse above or same line as point */
3575 if (x_mouse_y >= point_y) /* Flipped. */
3577 mouse_below_point = 1;
3579 outline_region (f, f->display.x->reverse_gc,
3580 x_contour_x, x_contour_y, point_x, point_y);
3581 outline_region (f, f->display.x->cursor_gc, point_x, point_y,
3582 x_mouse_x, x_mouse_y);
3584 else if (x_mouse_y > x_contour_y) /* Top clipped. */
3586 clip_contour_top (x_mouse_y);
3588 else if (x_mouse_y < x_contour_y) /* Top extended. */
3590 extend_contour_top (x_mouse_y);
3595 unread_command_event = obj;
3596 if (mouse_below_point)
3598 contour_begin_x = point_x;
3599 contour_begin_y = point_y;
3600 contour_end_x = x_contour_x;
3601 contour_end_y = x_contour_y;
3603 else
3605 contour_begin_x = x_contour_x;
3606 contour_begin_y = x_contour_y;
3607 contour_end_x = point_x;
3608 contour_end_y = point_y;
3611 #endif
3613 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
3615 (event)
3616 Lisp_Object event;
3618 register Lisp_Object obj;
3619 struct frame *f = selected_frame;
3620 register struct window *w = XWINDOW (selected_window);
3621 register GC line_gc = f->display.x->cursor_gc;
3622 register GC erase_gc = f->display.x->reverse_gc;
3623 #if 0
3624 char dash_list[] = {6, 4, 6, 4};
3625 int dashes = 4;
3626 XGCValues gc_values;
3627 #endif
3628 register int previous_y;
3629 register int line = (x_mouse_y + 1) * f->display.x->line_height
3630 + f->display.x->internal_border_width;
3631 register int left = f->display.x->internal_border_width
3632 + (w->left
3633 * FONT_WIDTH (f->display.x->font));
3634 register int right = left + (w->width
3635 * FONT_WIDTH (f->display.x->font))
3636 - f->display.x->internal_border_width;
3638 #if 0
3639 BLOCK_INPUT;
3640 gc_values.foreground = f->display.x->cursor_pixel;
3641 gc_values.background = f->display.x->background_pixel;
3642 gc_values.line_width = 1;
3643 gc_values.line_style = LineOnOffDash;
3644 gc_values.cap_style = CapRound;
3645 gc_values.join_style = JoinRound;
3647 line_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3648 GCLineStyle | GCJoinStyle | GCCapStyle
3649 | GCLineWidth | GCForeground | GCBackground,
3650 &gc_values);
3651 XSetDashes (x_current_display, line_gc, 0, dash_list, dashes);
3652 gc_values.foreground = f->display.x->background_pixel;
3653 gc_values.background = f->display.x->foreground_pixel;
3654 erase_gc = XCreateGC (x_current_display, FRAME_X_WINDOW (f),
3655 GCLineStyle | GCJoinStyle | GCCapStyle
3656 | GCLineWidth | GCForeground | GCBackground,
3657 &gc_values);
3658 XSetDashes (x_current_display, erase_gc, 0, dash_list, dashes);
3659 #endif
3661 while (1)
3663 BLOCK_INPUT;
3664 if (x_mouse_y >= XINT (w->top)
3665 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
3667 previous_y = x_mouse_y;
3668 line = (x_mouse_y + 1) * f->display.x->line_height
3669 + f->display.x->internal_border_width;
3670 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3671 line_gc, left, line, right, line);
3673 XFlushQueue ();
3674 UNBLOCK_INPUT;
3678 obj = read_char (-1, 0, 0, Qnil, 0);
3679 if ((XTYPE (obj) != Lisp_Cons)
3680 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
3681 Qvertical_scroll_bar))
3682 || x_mouse_grabbed)
3684 BLOCK_INPUT;
3685 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3686 erase_gc, left, line, right, line);
3687 UNBLOCK_INPUT;
3688 unread_command_event = obj;
3689 #if 0
3690 XFreeGC (x_current_display, line_gc);
3691 XFreeGC (x_current_display, erase_gc);
3692 #endif
3693 return Qnil;
3696 while (x_mouse_y == previous_y);
3698 BLOCK_INPUT;
3699 XDrawLine (x_current_display, FRAME_X_WINDOW (f),
3700 erase_gc, left, line, right, line);
3701 UNBLOCK_INPUT;
3704 #endif
3706 /* Offset in buffer of character under the pointer, or 0. */
3707 int mouse_buffer_offset;
3709 #if 0
3710 /* These keep track of the rectangle following the pointer. */
3711 int mouse_track_top, mouse_track_left, mouse_track_width;
3713 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
3714 "Track the pointer.")
3717 static Cursor current_pointer_shape;
3718 FRAME_PTR f = x_mouse_frame;
3720 BLOCK_INPUT;
3721 if (EQ (Vmouse_frame_part, Qtext_part)
3722 && (current_pointer_shape != f->display.x->nontext_cursor))
3724 unsigned char c;
3725 struct buffer *buf;
3727 current_pointer_shape = f->display.x->nontext_cursor;
3728 XDefineCursor (x_current_display,
3729 FRAME_X_WINDOW (f),
3730 current_pointer_shape);
3732 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
3733 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
3735 else if (EQ (Vmouse_frame_part, Qmodeline_part)
3736 && (current_pointer_shape != f->display.x->modeline_cursor))
3738 current_pointer_shape = f->display.x->modeline_cursor;
3739 XDefineCursor (x_current_display,
3740 FRAME_X_WINDOW (f),
3741 current_pointer_shape);
3744 XFlushQueue ();
3745 UNBLOCK_INPUT;
3747 #endif
3749 #if 0
3750 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
3751 "Draw rectangle around character under mouse pointer, if there is one.")
3752 (event)
3753 Lisp_Object event;
3755 struct window *w = XWINDOW (Vmouse_window);
3756 struct frame *f = XFRAME (WINDOW_FRAME (w));
3757 struct buffer *b = XBUFFER (w->buffer);
3758 Lisp_Object obj;
3760 if (! EQ (Vmouse_window, selected_window))
3761 return Qnil;
3763 if (EQ (event, Qnil))
3765 int x, y;
3767 x_read_mouse_position (selected_frame, &x, &y);
3770 BLOCK_INPUT;
3771 mouse_track_width = 0;
3772 mouse_track_left = mouse_track_top = -1;
3776 if ((x_mouse_x != mouse_track_left
3777 && (x_mouse_x < mouse_track_left
3778 || x_mouse_x > (mouse_track_left + mouse_track_width)))
3779 || x_mouse_y != mouse_track_top)
3781 int hp = 0; /* Horizontal position */
3782 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
3783 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
3784 int tab_width = XINT (b->tab_width);
3785 int ctl_arrow_p = !NILP (b->ctl_arrow);
3786 unsigned char c;
3787 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
3788 int in_mode_line = 0;
3790 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
3791 break;
3793 /* Erase previous rectangle. */
3794 if (mouse_track_width)
3796 x_rectangle (f, f->display.x->reverse_gc,
3797 mouse_track_left, mouse_track_top,
3798 mouse_track_width, 1);
3800 if ((mouse_track_left == f->phys_cursor_x
3801 || mouse_track_left == f->phys_cursor_x - 1)
3802 && mouse_track_top == f->phys_cursor_y)
3804 x_display_cursor (f, 1);
3808 mouse_track_left = x_mouse_x;
3809 mouse_track_top = x_mouse_y;
3810 mouse_track_width = 0;
3812 if (mouse_track_left > len) /* Past the end of line. */
3813 goto draw_or_not;
3815 if (mouse_track_top == mode_line_vpos)
3817 in_mode_line = 1;
3818 goto draw_or_not;
3821 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
3824 c = FETCH_CHAR (p);
3825 if (len == f->width && hp == len - 1 && c != '\n')
3826 goto draw_or_not;
3828 switch (c)
3830 case '\t':
3831 mouse_track_width = tab_width - (hp % tab_width);
3832 p++;
3833 hp += mouse_track_width;
3834 if (hp > x_mouse_x)
3836 mouse_track_left = hp - mouse_track_width;
3837 goto draw_or_not;
3839 continue;
3841 case '\n':
3842 mouse_track_width = -1;
3843 goto draw_or_not;
3845 default:
3846 if (ctl_arrow_p && (c < 040 || c == 0177))
3848 if (p > ZV)
3849 goto draw_or_not;
3851 mouse_track_width = 2;
3852 p++;
3853 hp +=2;
3854 if (hp > x_mouse_x)
3856 mouse_track_left = hp - mouse_track_width;
3857 goto draw_or_not;
3860 else
3862 mouse_track_width = 1;
3863 p++;
3864 hp++;
3866 continue;
3869 while (hp <= x_mouse_x);
3871 draw_or_not:
3872 if (mouse_track_width) /* Over text; use text pointer shape. */
3874 XDefineCursor (x_current_display,
3875 FRAME_X_WINDOW (f),
3876 f->display.x->text_cursor);
3877 x_rectangle (f, f->display.x->cursor_gc,
3878 mouse_track_left, mouse_track_top,
3879 mouse_track_width, 1);
3881 else if (in_mode_line)
3882 XDefineCursor (x_current_display,
3883 FRAME_X_WINDOW (f),
3884 f->display.x->modeline_cursor);
3885 else
3886 XDefineCursor (x_current_display,
3887 FRAME_X_WINDOW (f),
3888 f->display.x->nontext_cursor);
3891 XFlush (x_current_display);
3892 UNBLOCK_INPUT;
3894 obj = read_char (-1, 0, 0, Qnil, 0);
3895 BLOCK_INPUT;
3897 while (XTYPE (obj) == Lisp_Cons /* Mouse event */
3898 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
3899 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
3900 && EQ (Vmouse_window, selected_window) /* In this window */
3901 && x_mouse_frame);
3903 unread_command_event = obj;
3905 if (mouse_track_width)
3907 x_rectangle (f, f->display.x->reverse_gc,
3908 mouse_track_left, mouse_track_top,
3909 mouse_track_width, 1);
3910 mouse_track_width = 0;
3911 if ((mouse_track_left == f->phys_cursor_x
3912 || mouse_track_left - 1 == f->phys_cursor_x)
3913 && mouse_track_top == f->phys_cursor_y)
3915 x_display_cursor (f, 1);
3918 XDefineCursor (x_current_display,
3919 FRAME_X_WINDOW (f),
3920 f->display.x->nontext_cursor);
3921 XFlush (x_current_display);
3922 UNBLOCK_INPUT;
3924 return Qnil;
3926 #endif
3928 #if 0
3929 #include "glyphs.h"
3931 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
3932 on the frame F at position X, Y. */
3934 x_draw_pixmap (f, x, y, image_data, width, height)
3935 struct frame *f;
3936 int x, y, width, height;
3937 char *image_data;
3939 Pixmap image;
3941 image = XCreateBitmapFromData (x_current_display,
3942 FRAME_X_WINDOW (f), image_data,
3943 width, height);
3944 XCopyPlane (x_current_display, image, FRAME_X_WINDOW (f),
3945 f->display.x->normal_gc, 0, 0, width, height, x, y);
3947 #endif
3949 #ifndef HAVE_X11
3950 DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
3951 1, 1, "sStore text in cut buffer: ",
3952 "Store contents of STRING into the cut buffer of the X window system.")
3953 (string)
3954 register Lisp_Object string;
3956 int mask;
3958 CHECK_STRING (string, 1);
3959 if (! FRAME_X_P (selected_frame))
3960 error ("Selected frame does not understand X protocol.");
3962 BLOCK_INPUT;
3963 XStoreBytes ((char *) XSTRING (string)->data, XSTRING (string)->size);
3964 UNBLOCK_INPUT;
3966 return Qnil;
3969 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
3970 "Return contents of cut buffer of the X window system, as a string.")
3973 int len;
3974 register Lisp_Object string;
3975 int mask;
3976 register char *d;
3978 BLOCK_INPUT;
3979 d = XFetchBytes (&len);
3980 string = make_string (d, len);
3981 XFree (d);
3982 UNBLOCK_INPUT;
3983 return string;
3985 #endif /* X10 */
3987 #if 0 /* I'm told these functions are superfluous
3988 given the ability to bind function keys. */
3990 #ifdef HAVE_X11
3991 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
3992 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
3993 KEYSYM is a string which conforms to the X keysym definitions found\n\
3994 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
3995 list of strings specifying modifier keys such as Control_L, which must\n\
3996 also be depressed for NEWSTRING to appear.")
3997 (x_keysym, modifiers, newstring)
3998 register Lisp_Object x_keysym;
3999 register Lisp_Object modifiers;
4000 register Lisp_Object newstring;
4002 char *rawstring;
4003 register KeySym keysym;
4004 KeySym modifier_list[16];
4006 check_x ();
4007 CHECK_STRING (x_keysym, 1);
4008 CHECK_STRING (newstring, 3);
4010 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
4011 if (keysym == NoSymbol)
4012 error ("Keysym does not exist");
4014 if (NILP (modifiers))
4015 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
4016 XSTRING (newstring)->data, XSTRING (newstring)->size);
4017 else
4019 register Lisp_Object rest, mod;
4020 register int i = 0;
4022 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
4024 if (i == 16)
4025 error ("Can't have more than 16 modifiers");
4027 mod = Fcar (rest);
4028 CHECK_STRING (mod, 3);
4029 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
4030 #ifndef HAVE_X11R5
4031 if (modifier_list[i] == NoSymbol
4032 || !(IsModifierKey (modifier_list[i])
4033 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
4034 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
4035 #else
4036 if (modifier_list[i] == NoSymbol
4037 || !IsModifierKey (modifier_list[i]))
4038 #endif
4039 error ("Element is not a modifier keysym");
4040 i++;
4043 XRebindKeysym (x_current_display, keysym, modifier_list, i,
4044 XSTRING (newstring)->data, XSTRING (newstring)->size);
4047 return Qnil;
4050 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
4051 "Rebind KEYCODE to list of strings STRINGS.\n\
4052 STRINGS should be a list of 16 elements, one for each shift combination.\n\
4053 nil as element means don't change.\n\
4054 See the documentation of `x-rebind-key' for more information.")
4055 (keycode, strings)
4056 register Lisp_Object keycode;
4057 register Lisp_Object strings;
4059 register Lisp_Object item;
4060 register unsigned char *rawstring;
4061 KeySym rawkey, modifier[1];
4062 int strsize;
4063 register unsigned i;
4065 check_x ();
4066 CHECK_NUMBER (keycode, 1);
4067 CHECK_CONS (strings, 2);
4068 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
4069 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
4071 item = Fcar (strings);
4072 if (!NILP (item))
4074 CHECK_STRING (item, 2);
4075 strsize = XSTRING (item)->size;
4076 rawstring = (unsigned char *) xmalloc (strsize);
4077 bcopy (XSTRING (item)->data, rawstring, strsize);
4078 modifier[1] = 1 << i;
4079 XRebindKeysym (x_current_display, rawkey, modifier, 1,
4080 rawstring, strsize);
4083 return Qnil;
4085 #endif /* HAVE_X11 */
4086 #endif /* 0 */
4088 #ifdef HAVE_X11
4090 #ifndef HAVE_XSCREENNUMBEROFSCREEN
4092 XScreenNumberOfScreen (scr)
4093 register Screen *scr;
4095 register Display *dpy;
4096 register Screen *dpyscr;
4097 register int i;
4099 dpy = scr->display;
4100 dpyscr = dpy->screens;
4102 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
4103 if (scr == dpyscr)
4104 return i;
4106 return -1;
4108 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
4110 Visual *
4111 select_visual (screen, depth)
4112 Screen *screen;
4113 unsigned int *depth;
4115 Visual *v;
4116 XVisualInfo *vinfo, vinfo_template;
4117 int n_visuals;
4119 v = DefaultVisualOfScreen (screen);
4121 #ifdef HAVE_X11R4
4122 vinfo_template.visualid = XVisualIDFromVisual (v);
4123 #else
4124 vinfo_template.visualid = v->visualid;
4125 #endif
4127 vinfo_template.screen = XScreenNumberOfScreen (screen);
4129 vinfo = XGetVisualInfo (x_current_display,
4130 VisualIDMask | VisualScreenMask, &vinfo_template,
4131 &n_visuals);
4132 if (n_visuals != 1)
4133 fatal ("Can't get proper X visual info");
4135 if ((1 << vinfo->depth) == vinfo->colormap_size)
4136 *depth = vinfo->depth;
4137 else
4139 int i = 0;
4140 int n = vinfo->colormap_size - 1;
4141 while (n)
4143 n = n >> 1;
4144 i++;
4146 *depth = i;
4149 XFree ((char *) vinfo);
4150 return v;
4152 #endif /* HAVE_X11 */
4154 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
4155 1, 2, 0, "Open a connection to an X server.\n\
4156 DISPLAY is the name of the display to connect to.\n\
4157 Optional second arg XRM_STRING is a string of resources in xrdb format.")
4158 (display, xrm_string)
4159 Lisp_Object display, xrm_string;
4161 unsigned int n_planes;
4162 unsigned char *xrm_option;
4164 CHECK_STRING (display, 0);
4165 if (x_current_display != 0)
4166 error ("X server connection is already initialized");
4167 if (! NILP (xrm_string))
4168 CHECK_STRING (xrm_string, 1);
4170 if (! NILP (xrm_string))
4171 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
4172 else
4173 xrm_option = (unsigned char *) 0;
4175 validate_x_resource_name ();
4177 /* This is what opens the connection and sets x_current_display.
4178 This also initializes many symbols, such as those used for input. */
4179 x_term_init (XSTRING (display)->data, xrm_option,
4180 XSTRING (Vx_resource_name)->data);
4182 #ifdef HAVE_X11
4183 XFASTINT (Vwindow_system_version) = 11;
4185 BLOCK_INPUT;
4186 xrdb = x_load_resources (x_current_display, xrm_option,
4187 (char *) XSTRING (Vx_resource_name)->data,
4188 EMACS_CLASS);
4189 UNBLOCK_INPUT;
4190 #ifdef HAVE_XRMSETDATABASE
4191 XrmSetDatabase (x_current_display, xrdb);
4192 #else
4193 x_current_display->db = xrdb;
4194 #endif
4196 x_screen = DefaultScreenOfDisplay (x_current_display);
4198 screen_visual = select_visual (x_screen, &n_planes);
4199 x_screen_planes = n_planes;
4200 x_screen_height = HeightOfScreen (x_screen);
4201 x_screen_width = WidthOfScreen (x_screen);
4203 /* X Atoms used by emacs. */
4204 Xatoms_of_xselect ();
4205 BLOCK_INPUT;
4206 Xatom_wm_protocols = XInternAtom (x_current_display, "WM_PROTOCOLS",
4207 False);
4208 Xatom_wm_take_focus = XInternAtom (x_current_display, "WM_TAKE_FOCUS",
4209 False);
4210 Xatom_wm_save_yourself = XInternAtom (x_current_display, "WM_SAVE_YOURSELF",
4211 False);
4212 Xatom_wm_delete_window = XInternAtom (x_current_display, "WM_DELETE_WINDOW",
4213 False);
4214 Xatom_wm_change_state = XInternAtom (x_current_display, "WM_CHANGE_STATE",
4215 False);
4216 Xatom_wm_configure_denied = XInternAtom (x_current_display,
4217 "WM_CONFIGURE_DENIED", False);
4218 Xatom_wm_window_moved = XInternAtom (x_current_display, "WM_MOVED",
4219 False);
4220 Xatom_editres_name = XInternAtom (x_current_display, "Editres", False);
4221 UNBLOCK_INPUT;
4222 #else /* not HAVE_X11 */
4223 XFASTINT (Vwindow_system_version) = 10;
4224 #endif /* not HAVE_X11 */
4225 return Qnil;
4228 DEFUN ("x-close-current-connection", Fx_close_current_connection,
4229 Sx_close_current_connection,
4230 0, 0, 0, "Close the connection to the current X server.")
4233 /* Note: If we're going to call check_x here, then the fatal error
4234 can't happen. For the moment, this check is just for safety,
4235 so a user won't try out the function and get a crash. If it's
4236 really intended only to be called when killing emacs, then there's
4237 no reason for it to have a lisp interface at all. */
4238 check_x();
4239 #ifdef HAVE_X11
4240 /* This is ONLY used when killing emacs; For switching displays
4241 we'll have to take care of setting CloseDownMode elsewhere. */
4243 if (x_current_display)
4245 BLOCK_INPUT;
4246 XSetCloseDownMode (x_current_display, DestroyAll);
4247 XCloseDisplay (x_current_display);
4248 x_current_display = 0;
4250 else
4251 fatal ("No current X display connection to close\n");
4252 #endif
4253 return Qnil;
4256 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize,
4257 1, 1, 0, "If ON is non-nil, report X errors as soon as the erring request is made.\n\
4258 If ON is nil, allow buffering of requests.\n\
4259 Turning on synchronization prohibits the Xlib routines from buffering\n\
4260 requests and seriously degrades performance, but makes debugging much\n\
4261 easier.")
4262 (on)
4263 Lisp_Object on;
4265 check_x ();
4267 XSynchronize (x_current_display, !EQ (on, Qnil));
4269 return Qnil;
4272 /* Wait for responses to all X commands issued so far for FRAME. */
4274 void
4275 x_sync (frame)
4276 Lisp_Object frame;
4278 BLOCK_INPUT;
4279 XSync (x_current_display, False);
4280 UNBLOCK_INPUT;
4283 syms_of_xfns ()
4285 /* This is zero if not using X windows. */
4286 x_current_display = 0;
4288 /* The section below is built by the lisp expression at the top of the file,
4289 just above where these variables are declared. */
4290 /*&&& init symbols here &&&*/
4291 Qauto_raise = intern ("auto-raise");
4292 staticpro (&Qauto_raise);
4293 Qauto_lower = intern ("auto-lower");
4294 staticpro (&Qauto_lower);
4295 Qbackground_color = intern ("background-color");
4296 staticpro (&Qbackground_color);
4297 Qbar = intern ("bar");
4298 staticpro (&Qbar);
4299 Qborder_color = intern ("border-color");
4300 staticpro (&Qborder_color);
4301 Qborder_width = intern ("border-width");
4302 staticpro (&Qborder_width);
4303 Qbox = intern ("box");
4304 staticpro (&Qbox);
4305 Qcursor_color = intern ("cursor-color");
4306 staticpro (&Qcursor_color);
4307 Qcursor_type = intern ("cursor-type");
4308 staticpro (&Qcursor_type);
4309 Qfont = intern ("font");
4310 staticpro (&Qfont);
4311 Qforeground_color = intern ("foreground-color");
4312 staticpro (&Qforeground_color);
4313 Qgeometry = intern ("geometry");
4314 staticpro (&Qgeometry);
4315 Qicon_left = intern ("icon-left");
4316 staticpro (&Qicon_left);
4317 Qicon_top = intern ("icon-top");
4318 staticpro (&Qicon_top);
4319 Qicon_type = intern ("icon-type");
4320 staticpro (&Qicon_type);
4321 Qinternal_border_width = intern ("internal-border-width");
4322 staticpro (&Qinternal_border_width);
4323 Qleft = intern ("left");
4324 staticpro (&Qleft);
4325 Qmouse_color = intern ("mouse-color");
4326 staticpro (&Qmouse_color);
4327 Qnone = intern ("none");
4328 staticpro (&Qnone);
4329 Qparent_id = intern ("parent-id");
4330 staticpro (&Qparent_id);
4331 Qsuppress_icon = intern ("suppress-icon");
4332 staticpro (&Qsuppress_icon);
4333 Qtop = intern ("top");
4334 staticpro (&Qtop);
4335 Qundefined_color = intern ("undefined-color");
4336 staticpro (&Qundefined_color);
4337 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
4338 staticpro (&Qvertical_scroll_bars);
4339 Qvisibility = intern ("visibility");
4340 staticpro (&Qvisibility);
4341 Qwindow_id = intern ("window-id");
4342 staticpro (&Qwindow_id);
4343 Qx_frame_parameter = intern ("x-frame-parameter");
4344 staticpro (&Qx_frame_parameter);
4345 Qx_resource_name = intern ("x-resource-name");
4346 staticpro (&Qx_resource_name);
4347 Quser_position = intern ("user-position");
4348 staticpro (&Quser_position);
4349 Quser_size = intern ("user-size");
4350 staticpro (&Quser_size);
4351 /* This is the end of symbol initialization. */
4353 Fput (Qundefined_color, Qerror_conditions,
4354 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
4355 Fput (Qundefined_color, Qerror_message,
4356 build_string ("Undefined color"));
4358 init_x_parm_symbols ();
4360 DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset,
4361 "The buffer offset of the character under the pointer.");
4362 mouse_buffer_offset = 0;
4364 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
4365 "The shape of the pointer when over text.\n\
4366 Changing the value does not affect existing frames\n\
4367 unless you set the mouse color.");
4368 Vx_pointer_shape = Qnil;
4370 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
4371 "The name Emacs uses to look up X resources; for internal use only.\n\
4372 `x-get-resource' uses this as the first component of the instance name\n\
4373 when requesting resource values.\n\
4374 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
4375 was invoked, or to the value specified with the `-name' or `-rn'\n\
4376 switches, if present.");
4377 Vx_resource_name = Qnil;
4379 #if 0 /* This doesn't really do anything. */
4380 DEFVAR_INT ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
4381 "The shape of the pointer when not over text.\n\
4382 This variable takes effect when you create a new frame\n\
4383 or when you set the mouse color.");
4384 #endif
4385 Vx_nontext_pointer_shape = Qnil;
4387 #if 0 /* This doesn't really do anything. */
4388 DEFVAR_INT ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
4389 "The shape of the pointer when over the mode line.\n\
4390 This variable takes effect when you create a new frame\n\
4391 or when you set the mouse color.");
4392 #endif
4393 Vx_mode_pointer_shape = Qnil;
4395 DEFVAR_INT ("x-sensitive-text-pointer-shape",
4396 &Vx_sensitive_text_pointer_shape,
4397 "The shape of the pointer when over mouse-sensitive text.\n\
4398 This variable takes effect when you create a new frame\n\
4399 or when you set the mouse color.");
4400 Vx_sensitive_text_pointer_shape = Qnil;
4402 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
4403 "A string indicating the foreground color of the cursor box.");
4404 Vx_cursor_fore_pixel = Qnil;
4406 DEFVAR_LISP ("mouse-grabbed", &Vmouse_depressed,
4407 "Non-nil if a mouse button is currently depressed.");
4408 Vmouse_depressed = Qnil;
4410 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
4411 "t if no X window manager is in use.");
4413 #ifdef HAVE_X11
4414 defsubr (&Sx_get_resource);
4415 #if 0
4416 defsubr (&Sx_draw_rectangle);
4417 defsubr (&Sx_erase_rectangle);
4418 defsubr (&Sx_contour_region);
4419 defsubr (&Sx_uncontour_region);
4420 #endif
4421 defsubr (&Sx_display_color_p);
4422 defsubr (&Sx_list_fonts);
4423 defsubr (&Sx_color_defined_p);
4424 defsubr (&Sx_server_max_request_size);
4425 defsubr (&Sx_server_vendor);
4426 defsubr (&Sx_server_version);
4427 defsubr (&Sx_display_pixel_width);
4428 defsubr (&Sx_display_pixel_height);
4429 defsubr (&Sx_display_mm_width);
4430 defsubr (&Sx_display_mm_height);
4431 defsubr (&Sx_display_screens);
4432 defsubr (&Sx_display_planes);
4433 defsubr (&Sx_display_color_cells);
4434 defsubr (&Sx_display_visual_class);
4435 defsubr (&Sx_display_backing_store);
4436 defsubr (&Sx_display_save_under);
4437 #if 0
4438 defsubr (&Sx_rebind_key);
4439 defsubr (&Sx_rebind_keys);
4440 defsubr (&Sx_track_pointer);
4441 defsubr (&Sx_grab_pointer);
4442 defsubr (&Sx_ungrab_pointer);
4443 #endif
4444 #else
4445 defsubr (&Sx_get_default);
4446 defsubr (&Sx_store_cut_buffer);
4447 defsubr (&Sx_get_cut_buffer);
4448 #endif
4449 defsubr (&Sx_parse_geometry);
4450 defsubr (&Sx_create_frame);
4451 defsubr (&Sfocus_frame);
4452 defsubr (&Sunfocus_frame);
4453 #if 0
4454 defsubr (&Sx_horizontal_line);
4455 #endif
4456 defsubr (&Sx_open_connection);
4457 defsubr (&Sx_close_current_connection);
4458 defsubr (&Sx_synchronize);
4461 #endif /* HAVE_X_WINDOWS */