1 /* Device functions for X windows.
2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
3 Copyright (C) 1994, 1995 Free Software Foundation, Inc.
5 This file is part of XEmacs.
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* Synched up with: Not in FSF. */
24 /* 7-8-00 !!#### This file needs definite Mule review. */
26 /* Original authors: Jamie Zawinski and the FSF */
27 /* Rewritten by Ben Wing and Chuck Thompson. */
32 #include "console-x.h"
33 #include "xintrinsicp.h" /* CoreP.h needs this */
34 #include <X11/CoreP.h> /* Numerous places access the fields of
35 a core widget directly. We could
36 use XtGetValues(), but ... */
38 #include <X11/Shell.h>
41 #include "objects-x.h"
48 #include "redisplay.h"
55 #if defined(HAVE_SHLIB) && defined(LWLIB_USES_ATHENA) && !defined(HAVE_ATHENA_3D)
57 #endif /* HAVE_SHLIB and LWLIB_USES_ATHENA and not HAVE_ATHENA_3D */
63 Lisp_Object Vdefault_x_device;
64 #if defined(MULE) && (defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET))
65 Lisp_Object Vx_app_defaults_directory;
68 /* Qdisplay in general.c */
70 Lisp_Object Qinit_pre_x_win, Qinit_post_x_win;
72 /* The application class of Emacs. */
73 Lisp_Object Vx_emacs_application_class;
75 Lisp_Object Vx_initial_argv_list; /* #### ugh! */
77 static XrmOptionDescRec emacs_options[] =
79 {"-geometry", ".geometry", XrmoptionSepArg, NULL},
80 {"-iconic", ".iconic", XrmoptionNoArg, "yes"},
82 {"-internal-border-width", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL},
83 {"-ib", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL},
84 {"-scrollbar-width", "*EmacsFrame.scrollBarWidth", XrmoptionSepArg, NULL},
85 {"-scrollbar-height", "*EmacsFrame.scrollBarHeight", XrmoptionSepArg, NULL},
87 {"-privatecolormap", ".privateColormap", XrmoptionNoArg, "yes"},
88 {"-visual", ".EmacsVisual", XrmoptionSepArg, NULL},
90 /* #### Beware! If the type of the shell changes, update this. */
91 {"-T", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
92 {"-wn", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
93 {"-title", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
95 {"-iconname", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL},
96 {"-in", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL},
97 {"-mc", "*pointerColor", XrmoptionSepArg, NULL},
98 {"-cr", "*cursorColor", XrmoptionSepArg, NULL},
99 {"-fontset", "*FontSet", XrmoptionSepArg, NULL},
102 /* Functions to synchronize mirroring resources and specifiers */
103 int in_resource_setting;
105 /************************************************************************/
106 /* helper functions */
107 /************************************************************************/
109 /* JH 97/11/25 removed the static declaration because I need it during setup in event-Xt... */
110 struct device * get_device_from_display_1 (Display *dpy);
112 get_device_from_display_1 (Display *dpy)
114 Lisp_Object devcons, concons;
116 DEVICE_LOOP_NO_BREAK (devcons, concons)
118 struct device *d = XDEVICE (XCAR (devcons));
119 if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d) == dpy)
127 get_device_from_display (Display *dpy)
129 struct device *d = get_device_from_display_1 (dpy);
131 #if !defined(INFODOCK)
132 # define FALLBACK_RESOURCE_NAME "xemacs"
134 # define FALLBACK_RESOURCE_NAME "infodock"
138 /* This isn't one of our displays. Let's crash? */
140 ("\n%s: Fatal X Condition. Asked about display we don't own: \"%s\"\n",
141 (STRINGP (Vinvocation_name) ?
142 (char *) XSTRING_DATA (Vinvocation_name) : FALLBACK_RESOURCE_NAME),
143 DisplayString (dpy) ? DisplayString (dpy) : "???");
147 #undef FALLBACK_RESOURCE_NAME
153 decode_x_device (Lisp_Object device)
155 XSETDEVICE (device, decode_device (device));
156 CHECK_X_DEVICE (device);
157 return XDEVICE (device);
161 get_x_display (Lisp_Object device)
163 return DEVICE_X_DISPLAY (decode_x_device (device));
167 /************************************************************************/
168 /* initializing an X connection */
169 /************************************************************************/
171 static struct device *device_being_initialized = NULL;
174 allocate_x_device_struct (struct device *d)
176 d->device_data = xnew_and_zero (struct x_device);
180 Xatoms_of_device_x (struct device *d)
182 Display *D = DEVICE_X_DISPLAY (d);
184 DEVICE_XATOM_WM_PROTOCOLS (d) = XInternAtom (D, "WM_PROTOCOLS", False);
185 DEVICE_XATOM_WM_DELETE_WINDOW(d) = XInternAtom (D, "WM_DELETE_WINDOW",False);
186 DEVICE_XATOM_WM_SAVE_YOURSELF(d) = XInternAtom (D, "WM_SAVE_YOURSELF",False);
187 DEVICE_XATOM_WM_TAKE_FOCUS (d) = XInternAtom (D, "WM_TAKE_FOCUS", False);
188 DEVICE_XATOM_WM_STATE (d) = XInternAtom (D, "WM_STATE", False);
192 sanity_check_geometry_resource (Display *dpy)
194 char *app_name, *app_class, *s;
195 char buf1 [255], buf2 [255];
198 XtGetApplicationNameAndClass (dpy, &app_name, &app_class);
199 strcpy (buf1, app_name);
200 strcpy (buf2, app_class);
201 for (s = buf1; *s; s++) if (*s == '.') *s = '_';
202 strcat (buf1, "._no_._such_._resource_.geometry");
203 strcat (buf2, "._no_._such_._resource_.Geometry");
204 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)
206 warn_when_safe (Qgeometry, Qerror,
208 "Apparently \"%s*geometry: %s\" or \"%s*geometry: %s\" was\n"
209 "specified in the resource database. Specifying \"*geometry\" will make\n"
210 "XEmacs (and most other X programs) malfunction in obscure ways. (i.e.\n"
211 "the Xt or Xm libraries will probably crash, which is a very bad thing.)\n"
212 "You should always use \".geometry\" or \"*EmacsFrame.geometry\" instead.\n",
213 app_name, (char *) value.addr,
214 app_class, (char *) value.addr);
215 suppress_early_error_handler_backtrace = 1;
216 error ("Invalid geometry resource");
221 x_init_device_class (struct device *d)
223 if (DEVICE_X_DEPTH(d) > 2)
225 switch (DEVICE_X_VISUAL(d)->class)
229 DEVICE_CLASS (d) = Qgrayscale;
232 DEVICE_CLASS (d) = Qcolor;
236 DEVICE_CLASS (d) = Qmono;
240 * Figure out what application name to use for xemacs
242 * Since we have decomposed XtOpenDisplay into XOpenDisplay and
243 * XtDisplayInitialize, we no longer get this for free.
245 * If there is a `-name' argument in argv, use that.
246 * Otherwise use the last component of argv[0].
248 * I have removed the gratuitous use of getenv("RESOURCE_NAME")
249 * which was in X11R5, but left the matching of any prefix of `-name'.
250 * Finally, if all else fails, return `xemacs', as it is more
251 * appropriate (X11R5 returns `main').
254 compute_x_app_name (int argc, Extbyte **argv)
259 for (i = 1; i < argc - 1; i++)
260 if (!strncmp(argv[i], "-name", max (2, strlen (argv[1]))))
263 if (argc > 0 && argv[0] && *argv[0])
264 return (ptr = strrchr (argv[0], '/')) ? ++ptr : argv[0];
270 * This function figures out whether the user has any resources of the
271 * form "XEmacs.foo" or "XEmacs*foo".
273 * Currently we only consult the display's global resources; to look
274 * for screen specific resources, we would need to also consult:
275 * xdefs = XScreenResourceString(ScreenOfDisplay(dpy, scrno));
278 have_xemacs_resources_in_xrdb (Display *dpy)
293 xdefs = XResourceManagerString (dpy); /* don't free - owned by X */
294 while (xdefs && *xdefs)
296 if (strncmp (xdefs, key, len) == 0 &&
297 (xdefs[len] == '*' || xdefs[len] == '.'))
300 while (*xdefs && *xdefs++ != '\n') /* find start of next entry.. */
307 /* Only the characters [-_A-Za-z0-9] are allowed in the individual
308 components of a resource. Convert invalid characters to `-' */
310 static char valid_resource_char_p[256];
313 validify_resource_component (char *str, size_t len)
315 for (; len; len--, str++)
316 if (!valid_resource_char_p[(unsigned char) (*str)])
321 Dynarr_add_validified_lisp_string (char_dynarr *cda, Lisp_Object str)
323 Bytecount len = XSTRING_LENGTH (str);
324 Dynarr_add_many (cda, (char *) XSTRING_DATA (str), len);
325 validify_resource_component (Dynarr_atp (cda, Dynarr_length (cda) - len), len);
329 /* compare visual info for qsorting */
331 x_comp_visual_info (const void *elem1, const void *elem2)
333 XVisualInfo *left, *right;
335 left = (XVisualInfo *)elem1;
336 right = (XVisualInfo *)elem2;
343 if ( left->depth > right->depth ) {
346 else if ( left->depth == right->depth ) {
347 if ( left->colormap_size > right->colormap_size )
349 if ( left->class > right->class )
351 else if ( left->class < right->class )
363 #define XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN
365 x_try_best_visual_class (Screen *screen, int scrnum, int visual_class)
367 Display *dpy = DisplayOfScreen (screen);
369 XVisualInfo *vi_out = NULL;
372 vi_in.class = visual_class;
373 vi_in.screen = scrnum;
374 vi_out = XGetVisualInfo (dpy, (VisualClassMask | VisualScreenMask),
380 for (i = 0, best = 0; i < out_count; i++)
381 /* It's better if it's deeper, or if it's the same depth with
382 more cells (does that ever happen? Well, it could...)
383 NOTE: don't allow pseudo color to get larger than 8! */
384 if (((vi_out [i].depth > vi_out [best].depth) ||
385 ((vi_out [i].depth == vi_out [best].depth) &&
386 (vi_out [i].colormap_size > vi_out [best].colormap_size)))
387 #ifdef XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN
388 /* For now, the image library doesn't like PseudoColor visuals
389 of depths other than 1 or 8. Depths greater than 8 only occur
390 on machines which have TrueColor anyway, so probably we'll end
391 up using that (it is the one that `Best' would pick) but if a
392 PseudoColor visual is explicitly specified, pick the 8 bit one.
394 && (visual_class != PseudoColor ||
395 vi_out [i].depth == 1 ||
396 vi_out [i].depth == 8)
399 /* SGI has 30-bit deep visuals. Ignore them.
400 (We only have 24-bit data anyway.)
402 && (vi_out [i].depth <= 24)
405 visual = vi_out[best].visual;
406 XFree ((char *) vi_out);
414 x_get_visual_depth (Display *dpy, Visual *visual)
420 vi_in.visualid = XVisualIDFromVisual (visual);
421 vi_out = XGetVisualInfo (dpy, /*VisualScreenMask|*/VisualIDMask,
423 if (! vi_out) ABORT ();
424 d = vi_out [0].depth;
425 XFree ((char *) vi_out);
430 x_try_best_visual (Display *dpy, int scrnum)
432 Visual *visual = NULL;
433 Screen *screen = ScreenOfDisplay (dpy, scrnum);
434 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor))
435 && x_get_visual_depth (dpy, visual) >= 16 )
437 if ((visual = x_try_best_visual_class (screen, scrnum, PseudoColor)))
439 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor)))
441 #ifdef DIRECTCOLOR_WORKS
442 if ((visual = x_try_best_visual_class (screen, scrnum, DirectColor)))
446 visual = DefaultVisualOfScreen (screen);
447 if ( x_get_visual_depth (dpy, visual) >= 8 )
450 if ((visual = x_try_best_visual_class (screen, scrnum, StaticGray)))
452 if ((visual = x_try_best_visual_class (screen, scrnum, GrayScale)))
454 return DefaultVisualOfScreen (screen);
459 x_init_device (struct device *d, Lisp_Object props)
467 const char *app_class;
468 const char *app_name;
469 const char *disp_name;
470 Visual *visual = NULL;
471 int depth = 8; /* shut up the compiler */
475 int best_visual_found = 0;
477 #if defined(HAVE_SHLIB) && defined(LWLIB_USES_ATHENA) && !defined(HAVE_ATHENA_3D)
479 * In order to avoid the lossage with flat Athena widgets dynamically
480 * linking to one of the ThreeD variants, using the dynamic symbol helpers
481 * to look for symbols that shouldn't be there and refusing to run if they
482 * are seems a less toxic idea than having XEmacs crash when we try and
483 * use a subclass of a widget that has changed size.
485 * It's ugly, I know, and not going to work everywhere. It seems better to
486 * do our damnedest to try and tell the user what to expect rather than
487 * simply blow up though.
489 * All the ThreeD variants I have access to define the following function
490 * symbols in the shared library. The flat Xaw library does not define them:
492 * Xaw3dComputeBottomShadowRGB
493 * Xaw3dComputeTopShadowRGB
495 * So far only Linux has shown this problem. This seems to be portable to
496 * all the distributions (certainly all the ones I checked - Debian and
499 * This will only work, sadly, with dlopen() -- the other dynamic linkers
500 * are simply not capable of doing what is needed. :/
504 /* Get a dll handle to the main process. */
505 dll_handle xaw_dll_handle = dll_open (NULL);
507 /* Did that fail? If so, continue without error.
508 * We could die here but, well, that's unfriendly and all -- plus I feel
509 * better about some crashing somewhere rather than preventing a perfectly
510 * good configuration working just because dll_open failed.
512 if (xaw_dll_handle != NULL)
514 /* Look for the Xaw3d function */
515 dll_func xaw_function_handle =
516 dll_function (xaw_dll_handle, "Xaw3dComputeTopShadowRGB");
518 /* If we found it, warn the user in big, nasty, unfriendly letters */
519 if (xaw_function_handle != NULL)
521 warn_when_safe (Qdevice, Qerror, "\n"
522 "It seems that XEmacs is built dynamically linked to the flat Athena widget\n"
523 "library but it finds a 3D Athena variant with the same name at runtime.\n"
525 "This WILL cause your XEmacs process to dump core at some point.\n"
526 "You should not continue to use this binary without resolving this issue.\n"
528 "This can be solved with the xaw-wrappers package under Debian\n"
529 "(register XEmacs as incompatible with all 3d widget sets, see\n"
530 "update-xaw-wrappers(8) and .../doc/xaw-wrappers/README.packagers). It\n"
531 "can be verified by checking the runtime path in /etc/ld.so.conf and by\n"
532 "using `ldd /path/to/xemacs' under other Linux distributions. One\n"
533 "solution is to use LD_PRELOAD or LD_LIBRARY_PATH to force ld.so to\n"
534 "load the flat Athena widget library instead of the aliased 3D widget\n"
535 "library (see ld.so(8) for use of these environment variables).\n\n"
540 /* Otherwise release the handle to the library
541 * No error catch here; I can't think of a way to recover anyhow.
543 dll_close (xaw_dll_handle);
546 #endif /* HAVE_SHLIB and LWLIB_USES_ATHENA and not HAVE_ATHENA_3D */
549 XSETDEVICE (device, d);
550 display = DEVICE_CONNECTION (d);
552 allocate_x_device_struct (d);
554 make_argc_argv (Vx_initial_argv_list, &argc, &argv);
556 LISP_STRING_TO_EXTERNAL (display, disp_name, Qctext);
559 * Break apart the old XtOpenDisplay call into XOpenDisplay and
560 * XtDisplayInitialize so we can figure out whether there
561 * are any XEmacs resources in the resource database before
562 * we initialize Xt. This is so we can automagically support
563 * both `Emacs' and `XEmacs' application classes.
565 slow_down_interrupts ();
566 /* May not be needed but XtOpenDisplay could not deal with signals here. */
567 device_being_initialized = d;
568 dpy = DEVICE_X_DISPLAY (d) = XOpenDisplay (disp_name);
569 device_being_initialized = NULL;
570 speed_up_interrupts ();
574 suppress_early_error_handler_backtrace = 1;
575 signal_simple_error ("X server not responding\n", display);
578 if (STRINGP (Vx_emacs_application_class) &&
579 XSTRING_LENGTH (Vx_emacs_application_class) > 0)
580 LISP_STRING_TO_EXTERNAL (Vx_emacs_application_class, app_class, Qctext);
583 app_class = (NILP (Vx_emacs_application_class) &&
584 have_xemacs_resources_in_xrdb (dpy))
591 /* need to update Vx_emacs_application_class: */
592 Vx_emacs_application_class = build_string (app_class);
595 slow_down_interrupts ();
596 /* May not be needed but XtOpenDisplay could not deal with signals here.
598 XtDisplayInitialize (Xt_app_con, dpy, compute_x_app_name (argc, argv),
599 app_class, emacs_options,
600 XtNumber (emacs_options), &argc, (char **) argv);
601 speed_up_interrupts ();
603 screen = DefaultScreen (dpy);
604 if (NILP (Vdefault_x_device))
605 Vdefault_x_device = device;
608 #if defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET)
610 /* Read in locale-specific resources from
611 data-directory/app-defaults/$LANG/Emacs.
612 This is in addition to the standard app-defaults files, and
613 does not override resources defined elsewhere */
614 const char *data_dir;
616 XrmDatabase db = XtDatabase (dpy); /* #### XtScreenDatabase(dpy) ? */
617 const char *locale = XrmLocaleOfDatabase (db);
619 if (STRINGP (Vx_app_defaults_directory) &&
620 XSTRING_LENGTH (Vx_app_defaults_directory) > 0)
622 LISP_STRING_TO_EXTERNAL (Vx_app_defaults_directory, data_dir, Qfile_name);
623 path = (char *)alloca (strlen (data_dir) + strlen (locale) + 7);
624 sprintf (path, "%s%s/Emacs", data_dir, locale);
625 if (!access (path, R_OK))
626 XrmCombineFileDatabase (path, &db, False);
628 else if (STRINGP (Vdata_directory) && XSTRING_LENGTH (Vdata_directory) > 0)
630 LISP_STRING_TO_EXTERNAL (Vdata_directory, data_dir, Qfile_name);
631 path = (char *)alloca (strlen (data_dir) + 13 + strlen (locale) + 7);
632 sprintf (path, "%sapp-defaults/%s/Emacs", data_dir, locale);
633 if (!access (path, R_OK))
634 XrmCombineFileDatabase (path, &db, False);
637 #endif /* LWLIB_MENUBARS_MOTIF or HAVE_XIM USE_XFONTSET */
640 if (NILP (DEVICE_NAME (d)))
641 DEVICE_NAME (d) = display;
643 /* We're going to modify the string in-place, so be a nice XEmacs */
644 DEVICE_NAME (d) = Fcopy_sequence (DEVICE_NAME (d));
645 /* colons and periods can't appear in individual elements of resource
648 XtGetApplicationNameAndClass (dpy, (char **) &app_name, (char **) &app_class);
649 /* search for a matching visual if requested by the user, or setup the display default */
651 int resource_name_length = max (sizeof (".emacsVisual"),
652 sizeof (".privateColormap"));
653 char *buf1 = alloca_array (char, strlen (app_name) + resource_name_length);
654 char *buf2 = alloca_array (char, strlen (app_class) + resource_name_length);
658 sprintf (buf1, "%s.emacsVisual", app_name);
659 sprintf (buf2, "%s.EmacsVisual", app_class);
660 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)
663 int vis_class = PseudoColor;
665 char *str = (char*) value.addr;
667 #define CHECK_VIS_CLASS(visual_class) \
668 else if (memcmp (str, #visual_class, sizeof (#visual_class) - 1) == 0) \
669 cnt = sizeof (#visual_class) - 1, vis_class = visual_class
673 CHECK_VIS_CLASS (StaticGray);
674 CHECK_VIS_CLASS (StaticColor);
675 CHECK_VIS_CLASS (TrueColor);
676 CHECK_VIS_CLASS (GrayScale);
677 CHECK_VIS_CLASS (PseudoColor);
678 CHECK_VIS_CLASS (DirectColor);
682 depth = atoi (str + cnt);
685 stderr_out ("Invalid Depth specification in %s... ignoring...\n", str);
689 if (XMatchVisualInfo (dpy, screen, depth, vis_class, &vinfo))
691 visual = vinfo.visual;
695 stderr_out ("Can't match the requested visual %s... using defaults\n", str);
701 stderr_out( "Invalid Visual specification in %s... ignoring.\n", str);
707 visual = DefaultVisual(dpy, screen);
708 depth = DefaultDepth(dpy, screen);
710 visual = x_try_best_visual (dpy, screen);
711 depth = x_get_visual_depth (dpy, visual);
712 best_visual_found = (visual != DefaultVisual (dpy, screen));
715 /* If we've got the same visual as the default and it's PseudoColor,
716 check to see if the user specified that we need a private colormap */
717 if (visual == DefaultVisual (dpy, screen))
719 sprintf (buf1, "%s.privateColormap", app_name);
720 sprintf (buf2, "%s.PrivateColormap", app_class);
721 if ((visual->class == PseudoColor) &&
722 (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True))
724 cmap = XCopyColormapAndFree (dpy, DefaultColormap (dpy, screen));
728 cmap = DefaultColormap (dpy, screen);
733 if ( best_visual_found )
735 cmap = XCreateColormap (dpy, RootWindow (dpy, screen), visual, AllocNone);
739 /* We have to create a matching colormap anyway...
740 #### think about using standard colormaps (need the Xmu libs?) */
741 cmap = XCreateColormap(dpy, RootWindow(dpy, screen), visual, AllocNone);
742 XInstallColormap(dpy, cmap);
747 DEVICE_X_VISUAL (d) = visual;
748 DEVICE_X_COLORMAP (d) = cmap;
749 DEVICE_X_DEPTH (d) = depth;
750 validify_resource_component ((char *) XSTRING_DATA (DEVICE_NAME (d)),
751 XSTRING_LENGTH (DEVICE_NAME (d)));
755 XtSetArg (al[0], XtNvisual, visual);
756 XtSetArg (al[1], XtNdepth, depth);
757 XtSetArg (al[2], XtNcolormap, cmap);
759 app_shell = XtAppCreateShell (NULL, app_class,
760 applicationShellWidgetClass,
761 dpy, al, countof (al));
764 DEVICE_XT_APP_SHELL (d) = app_shell;
768 #endif /* HAVE_XIM */
770 /* Realize the app_shell so that its window exists for GC creation purposes,
771 and set it to the size of the root window for child placement purposes */
774 XtSetArg (al[0], XtNmappedWhenManaged, False);
775 XtSetArg (al[1], XtNx, 0);
776 XtSetArg (al[2], XtNy, 0);
777 XtSetArg (al[3], XtNwidth, WidthOfScreen (ScreenOfDisplay (dpy, screen)));
778 XtSetArg (al[4], XtNheight, HeightOfScreen (ScreenOfDisplay (dpy, screen)));
779 XtSetValues (app_shell, al, countof (al));
780 XtRealizeWidget (app_shell);
783 #ifdef HAVE_WMCOMMAND
787 make_argc_argv (Vcommand_line_args, &new_argc, &new_argv);
788 XSetCommand (XtDisplay (app_shell), XtWindow (app_shell),
789 (char **) new_argv, new_argc);
790 free_argc_argv (new_argv);
792 #endif /* HAVE_WMCOMMAND */
795 #ifdef HAVE_OFFIX_DND
796 DndInitialize ( app_shell );
799 Vx_initial_argv_list = make_arg_list (argc, argv);
800 free_argc_argv (argv);
802 DEVICE_X_WM_COMMAND_FRAME (d) = Qnil;
804 sanity_check_geometry_resource (dpy);
807 x_init_modifier_mapping (d);
809 DEVICE_INFD (d) = DEVICE_OUTFD (d) = ConnectionNumber (dpy);
813 DEVICE_X_GC_CACHE (d) = make_gc_cache (dpy, XtWindow(app_shell));
814 DEVICE_X_GRAY_PIXMAP (d) = None;
815 Xatoms_of_device_x (d);
816 Xatoms_of_select_x (d);
817 Xatoms_of_objects_x (d);
818 x_init_device_class (d);
820 /* Run the elisp side of the X device initialization. */
821 call0 (Qinit_pre_x_win);
825 x_finish_init_device (struct device *d, Lisp_Object props)
827 call0 (Qinit_post_x_win);
831 x_mark_device (struct device *d)
833 mark_object (DEVICE_X_WM_COMMAND_FRAME (d));
834 mark_object (DEVICE_X_DATA (d)->x_keysym_map_hash_table);
838 /************************************************************************/
839 /* closing an X connection */
840 /************************************************************************/
843 free_x_device_struct (struct device *d)
845 xfree (d->device_data);
849 x_delete_device (struct device *d)
854 extern void (*__free_hook) (void *);
858 XSETDEVICE (device, d);
859 display = DEVICE_X_DISPLAY (d);
864 checking_free = (__free_hook != 0);
866 /* Disable strict free checking, to avoid bug in X library */
868 disable_strict_free_check ();
871 free_gc_cache (DEVICE_X_GC_CACHE (d));
872 if (DEVICE_X_DATA (d)->x_modifier_keymap)
873 XFreeModifiermap (DEVICE_X_DATA (d)->x_modifier_keymap);
874 if (DEVICE_X_DATA (d)->x_keysym_map)
875 XFree ((char *) DEVICE_X_DATA (d)->x_keysym_map);
877 if (DEVICE_XT_APP_SHELL (d))
879 XtDestroyWidget (DEVICE_XT_APP_SHELL (d));
880 DEVICE_XT_APP_SHELL (d) = NULL;
883 XtCloseDisplay (display);
884 DEVICE_X_DISPLAY (d) = 0;
887 enable_strict_free_check ();
891 if (EQ (device, Vdefault_x_device))
893 Lisp_Object devcons, concons;
894 /* #### handle deleting last X device */
895 Vdefault_x_device = Qnil;
896 DEVICE_LOOP_NO_BREAK (devcons, concons)
898 if (DEVICE_X_P (XDEVICE (XCAR (devcons))) &&
899 !EQ (device, XCAR (devcons)))
901 Vdefault_x_device = XCAR (devcons);
907 free_x_device_struct (d);
911 /************************************************************************/
912 /* handle X errors */
913 /************************************************************************/
916 x_event_name (int event_type)
918 static const char *events[] =
958 if (event_type < 0 || event_type >= countof (events))
960 return events [event_type];
965 If an X error occurs which we are not expecting, we have no alternative
966 but to print it to stderr. It would be nice to stuff it into a pop-up
967 buffer, or to print it in the minibuffer, but that's not possible, because
968 one is not allowed to do any I/O on the display connection from an error
969 handler. The guts of Xlib expect these functions to either return or exit.
971 However, there are occasions when we might expect an error to reasonably
972 occur. The interface to this is as follows:
974 Before calling some X routine which may error, call
975 expect_x_error (dpy);
977 Just after calling the X routine, call either:
979 x_error_occurred_p (dpy);
981 to ask whether an error happened (and was ignored), or:
983 signal_if_x_error (dpy, resumable_p);
985 which will call Fsignal() with args appropriate to the X error, if there
986 was one. (Resumable_p is whether the debugger should be allowed to
987 continue from the call to signal.)
989 You must call one of these two routines immediately after calling the X
990 routine; think of them as bookends like BLOCK_INPUT and UNBLOCK_INPUT.
993 static int error_expected;
994 static int error_occurred;
995 static XErrorEvent last_error;
999 #ifdef EXTERNAL_WIDGET
1001 x_error_handler_do_enqueue (Lisp_Object frame)
1003 enqueue_magic_eval_event (io_error_delete_frame, frame);
1008 x_error_handler_error (Lisp_Object data, Lisp_Object dummy)
1012 #endif /* EXTERNAL_WIDGET */
1015 x_error_handler (Display *disp, XErrorEvent *event)
1021 last_error = *event;
1025 #ifdef EXTERNAL_WIDGET
1027 struct device *d = get_device_from_display (disp);
1029 if ((event->error_code == BadWindow ||
1030 event->error_code == BadDrawable)
1031 && ((f = x_any_window_to_frame (d, event->resourceid)) != 0))
1035 /* one of the windows comprising one of our frames has died.
1036 This occurs particularly with ExternalShell frames when the
1037 client that owns the ExternalShell's window dies.
1039 We cannot do any I/O on the display connection so we need
1040 to enqueue an eval event so that the deletion happens
1043 Furthermore, we need to trap any errors (out-of-memory) that
1044 may occur when Fenqueue_eval_event is called.
1047 if (f->being_deleted)
1049 XSETFRAME (frame, f);
1050 if (!NILP (condition_case_1 (Qerror, x_error_handler_do_enqueue,
1051 frame, x_error_handler_error, Qnil)))
1053 f->being_deleted = 1;
1058 #endif /* EXTERNAL_WIDGET */
1061 /* This ends up calling X, which isn't allowed in an X error handler
1063 stderr_out ("\n%s: ",
1064 (STRINGP (Vinvocation_name)
1065 ? (char *) XSTRING_DATA (Vinvocation_name)
1068 XmuPrintDefaultErrorMessage (disp, event, stderr);
1074 expect_x_error (Display *dpy)
1076 assert (!error_expected);
1077 XSync (dpy, 0); /* handle pending errors before setting flag */
1083 x_error_occurred_p (Display *dpy)
1086 XSync (dpy, 0); /* handle pending errors before setting flag */
1087 val = error_occurred;
1094 signal_if_x_error (Display *dpy, int resumable_p)
1098 if (! x_error_occurred_p (dpy))
1101 sprintf (buf, "0x%X", (unsigned int) last_error.resourceid);
1102 data = Fcons (build_string (buf), data);
1105 sprintf (num, "%d", last_error.request_code);
1106 XGetErrorDatabaseText (last_error.display, "XRequest", num, "",
1109 sprintf (buf, "Request-%d", last_error.request_code);
1110 data = Fcons (build_string (buf), data);
1112 XGetErrorText (last_error.display, last_error.error_code, buf, sizeof (buf));
1113 data = Fcons (build_string (buf), data);
1115 Fsignal (Qx_error, data);
1116 if (! resumable_p) goto again;
1121 x_IO_error_handler (Display *disp)
1123 /* This function can GC */
1125 struct device *d = get_device_from_display_1 (disp);
1128 d = device_being_initialized;
1131 XSETDEVICE (dev, d);
1133 if (NILP (find_nonminibuffer_frame_not_on_device (dev)))
1135 /* We're going down. */
1137 ("\n%s: Fatal I/O Error %d (%s) on display connection \"%s\"\n",
1138 (STRINGP (Vinvocation_name) ?
1139 (char *) XSTRING_DATA (Vinvocation_name) : "xemacs"),
1140 errno, strerror (errno), DisplayString (disp));
1142 (" after %lu requests (%lu known processed) with %d events remaining.\n",
1143 NextRequest (disp) - 1, LastKnownRequestProcessed (disp),
1145 /* assert (!_Xdebug); */
1151 "I/O Error %d (%s) on display connection\n"
1152 " \"%s\" after after %lu requests (%lu known processed)\n"
1153 " with %d events remaining.\n"
1154 " Throwing to top level.\n",
1155 errno, strerror (errno), DisplayString (disp),
1156 NextRequest (disp) - 1, LastKnownRequestProcessed (disp),
1160 /* According to X specs, we should not return from this function, or
1161 Xlib might just decide to exit(). So we mark the offending
1162 console for deletion and throw to top level. */
1165 enqueue_magic_eval_event (io_error_delete_device, dev);
1166 DEVICE_X_BEING_DELETED (d) = 1;
1168 Fthrow (Qtop_level, Qnil);
1170 return 0; /* not reached */
1173 DEFUN ("x-debug-mode", Fx_debug_mode, 1, 2, 0, /*
1174 With a true arg, make the connection to the X server synchronous.
1175 With false, make it asynchronous. Synchronous connections are much slower,
1176 but are useful for debugging. (If you get X errors, make the connection
1177 synchronous, and use a debugger to set a breakpoint on `x_error_handler'.
1178 Your backtrace of the C stack will now be useful. In asynchronous mode,
1179 the stack above `x_error_handler' isn't helpful because of buffering.)
1180 If DEVICE is not specified, the selected device is assumed.
1182 Calling this function is the same as calling the C function `XSynchronize',
1183 or starting the program with the `-sync' command line argument.
1187 struct device *d = decode_x_device (device);
1189 XSynchronize (DEVICE_X_DISPLAY (d), !NILP (arg));
1192 message ("X connection is synchronous");
1194 message ("X connection is asynchronous");
1200 /************************************************************************/
1202 /************************************************************************/
1204 #if 0 /* bah humbug. The whole "widget == resource" stuff is such
1205 a crock of shit that I'm just going to ignore it all. */
1207 /* If widget is NULL, we are retrieving device or global face data. */
1210 construct_name_list (Display *display, Widget widget, char *fake_name,
1211 char *fake_class, char *name, char *class)
1213 char *stack [100][2];
1216 char *name_tail, *class_tail;
1220 for (this = widget; this; this = XtParent (this))
1222 stack [count][0] = this->core.name;
1223 stack [count][1] = XtClass (this)->core_class.class_name;
1228 else if (fake_name && fake_class)
1230 stack [count][0] = fake_name;
1231 stack [count][1] = fake_class;
1235 /* The root widget is an application shell; resource lookups use the
1236 specified application name and application class in preference to
1237 the name/class of that widget (which is argv[0] / "ApplicationShell").
1238 Generally the app name and class will be argv[0] / "Emacs" but
1239 the former can be set via the -name command-line option, and the
1240 latter can be set by changing `x-emacs-application-class' in
1243 XtGetApplicationNameAndClass (display,
1252 for (; count >= 0; count--)
1254 strcat (name_tail, stack [count][0]);
1255 for (; *name_tail; name_tail++)
1256 if (*name_tail == '.') *name_tail = '_';
1257 strcat (name_tail, ".");
1260 strcat (class_tail, stack [count][1]);
1261 for (; *class_tail; class_tail++)
1262 if (*class_tail == '.') *class_tail = '_';
1263 strcat (class_tail, ".");
1270 /* strcasecmp() is not sufficiently portable or standard,
1271 and it's easier just to write our own. */
1273 ascii_strcasecmp (const char *s1, const char *s2)
1279 if (c1 >= 'A' && c1 <= 'Z') c1 += 'a' - 'A';
1280 if (c2 >= 'A' && c2 <= 'Z') c2 += 'a' - 'A';
1281 if (c1 != c2) return c1 - c2;
1282 if (c1 == '\0') return 0;
1286 static char_dynarr *name_char_dynarr;
1287 static char_dynarr *class_char_dynarr;
1289 /* Given a locale and device specification from x-get-resource or
1290 x-get-resource-prefix, return the resource prefix and display to
1291 fetch the resource on. */
1294 x_get_resource_prefix (Lisp_Object locale, Lisp_Object device,
1295 Display **display_out, char_dynarr *name,
1300 if (NILP (Fvalid_specifier_locale_p (locale)))
1301 signal_simple_error ("Invalid locale", locale);
1302 if (WINDOWP (locale))
1303 /* #### I can't come up with any coherent way of naming windows.
1304 By relative position? That seems tricky because windows
1305 can change position, be split, etc. By order of creation?
1306 That seems less than useful. */
1307 signal_simple_error ("Windows currently can't be resourced", locale);
1309 if (!NILP (device) && !DEVICEP (device))
1310 CHECK_DEVICE (device);
1311 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device)))
1315 device = DFW_DEVICE (locale);
1316 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device)))
1319 device = Vdefault_x_device;
1327 *display_out = DEVICE_X_DISPLAY (XDEVICE (device));
1330 char *appname, *appclass;
1331 int name_len, class_len;
1332 XtGetApplicationNameAndClass (*display_out, &appname, &appclass);
1333 name_len = strlen (appname);
1334 class_len = strlen (appclass);
1335 Dynarr_add_many (name , appname, name_len);
1336 Dynarr_add_many (class, appclass, class_len);
1337 validify_resource_component (Dynarr_atp (name, 0), name_len);
1338 validify_resource_component (Dynarr_atp (class, 0), class_len);
1341 if (EQ (locale, Qglobal))
1343 if (BUFFERP (locale))
1345 Dynarr_add_literal_string (name, ".buffer.");
1346 /* we know buffer is live; otherwise we got an error above. */
1347 Dynarr_add_validified_lisp_string (name, Fbuffer_name (locale));
1348 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsBuffer");
1350 else if (FRAMEP (locale))
1352 Dynarr_add_literal_string (name, ".frame.");
1353 /* we know frame is live; otherwise we got an error above. */
1354 Dynarr_add_validified_lisp_string (name, Fframe_name (locale));
1355 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsFrame");
1359 assert (DEVICEP (locale));
1360 Dynarr_add_literal_string (name, ".device.");
1361 /* we know device is live; otherwise we got an error above. */
1362 Dynarr_add_validified_lisp_string (name, Fdevice_name (locale));
1363 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsDevice");
1368 DEFUN ("x-get-resource", Fx_get_resource, 3, 6, 0, /*
1369 Retrieve an X resource from the resource manager.
1371 The first arg is the name of the resource to retrieve, such as "font".
1372 The second arg is the class of the resource to retrieve, such as "Font".
1373 The third arg must be one of the symbols 'string, 'integer, 'natnum, or
1374 'boolean, specifying the type of object that the database is searched for.
1375 The fourth arg is the locale to search for the resources on, and can
1376 currently be a buffer, a frame, a device, or 'global. If omitted, it
1377 defaults to 'global.
1378 The fifth arg is the device to search for the resources on. (The resource
1379 database for a particular device is constructed by combining non-device-
1380 specific resources such as any command-line resources specified and any
1381 app-defaults files found [or the fallback resources supplied by XEmacs,
1382 if no app-defaults file is found] with device-specific resources such as
1383 those supplied using xrdb.) If omitted, it defaults to the device of
1384 LOCALE, if a device can be derived (i.e. if LOCALE is a frame or device),
1385 and otherwise defaults to the value of `default-x-device'.
1386 The sixth arg NOERROR, if non-nil, means do not signal an error if a
1387 bogus resource specification was retrieved (e.g. if a non-integer was
1388 given when an integer was requested). In this case, a warning is issued
1389 instead, unless NOERROR is t, in which case no warning is issued.
1391 The resource names passed to this function are looked up relative to the
1394 If you want to search for a subresource, you just need to specify the
1395 resource levels in NAME and CLASS. For example, NAME could be
1396 "modeline.attributeFont", and CLASS "Face.AttributeFont".
1400 1) If LOCALE is a buffer, a call
1402 (x-get-resource "foreground" "Foreground" 'string SOME-BUFFER)
1404 is an interface to a C call something like
1406 XrmGetResource (db, "xemacs.buffer.BUFFER-NAME.foreground",
1407 "Emacs.EmacsLocaleType.EmacsBuffer.Foreground",
1410 2) If LOCALE is a frame, a call
1412 (x-get-resource "foreground" "Foreground" 'string SOME-FRAME)
1414 is an interface to a C call something like
1416 XrmGetResource (db, "xemacs.frame.FRAME-NAME.foreground",
1417 "Emacs.EmacsLocaleType.EmacsFrame.Foreground",
1420 3) If LOCALE is a device, a call
1422 (x-get-resource "foreground" "Foreground" 'string SOME-DEVICE)
1424 is an interface to a C call something like
1426 XrmGetResource (db, "xemacs.device.DEVICE-NAME.foreground",
1427 "Emacs.EmacsLocaleType.EmacsDevice.Foreground",
1430 4) If LOCALE is 'global, a call
1432 (x-get-resource "foreground" "Foreground" 'string 'global)
1434 is an interface to a C call something like
1436 XrmGetResource (db, "xemacs.foreground",
1440 Note that for 'global, no prefix is added other than that of the
1441 application itself; thus, you can use this locale to retrieve
1442 arbitrary application resources, if you really want to.
1444 The returned value of this function is nil if the queried resource is not
1445 found. If the third arg is `string', a string is returned, and if it is
1446 `integer', an integer is returned. If the third arg is `boolean', then the
1447 returned value is the list (t) for true, (nil) for false, and is nil to
1448 mean ``unspecified''.
1450 (name, class, type, locale, device, noerror))
1452 char* name_string, *class_string;
1456 Error_behavior errb = decode_error_behavior_flag (noerror);
1458 CHECK_STRING (name);
1459 CHECK_STRING (class);
1460 CHECK_SYMBOL (type);
1462 Dynarr_reset (name_char_dynarr);
1463 Dynarr_reset (class_char_dynarr);
1465 x_get_resource_prefix (locale, device, &display,
1466 name_char_dynarr, class_char_dynarr);
1470 db = XtDatabase (display);
1472 Dynarr_add (name_char_dynarr, '.');
1473 Dynarr_add_lisp_string (name_char_dynarr, name);
1474 Dynarr_add (class_char_dynarr, '.');
1475 Dynarr_add_lisp_string (class_char_dynarr, class);
1476 Dynarr_add (name_char_dynarr, '\0');
1477 Dynarr_add (class_char_dynarr, '\0');
1479 name_string = Dynarr_atp (name_char_dynarr, 0);
1480 class_string = Dynarr_atp (class_char_dynarr, 0);
1484 XrmName namelist[100];
1485 XrmClass classlist[100];
1486 XrmName *namerest = namelist;
1487 XrmClass *classrest = classlist;
1488 XrmRepresentation xrm_type;
1489 XrmRepresentation string_quark;
1491 XrmStringToNameList (name_string, namelist);
1492 XrmStringToClassList (class_string, classlist);
1493 string_quark = XrmStringToQuark ("String");
1495 /* ensure that they have the same length */
1496 while (namerest[0] && classrest[0])
1497 namerest++, classrest++;
1498 if (namerest[0] || classrest[0])
1499 signal_simple_error_2
1500 ("class list and name list must be the same length", name, class);
1501 result = XrmQGetResource (db, namelist, classlist, &xrm_type, &xrm_value);
1503 if (result != True || xrm_type != string_quark)
1505 raw_result = (char *) xrm_value.addr;
1508 if (EQ (type, Qstring))
1509 return build_string (raw_result);
1510 else if (EQ (type, Qboolean))
1512 if (!ascii_strcasecmp (raw_result, "off") ||
1513 !ascii_strcasecmp (raw_result, "false") ||
1514 !ascii_strcasecmp (raw_result, "no"))
1515 return Fcons (Qnil, Qnil);
1516 if (!ascii_strcasecmp (raw_result, "on") ||
1517 !ascii_strcasecmp (raw_result, "true") ||
1518 !ascii_strcasecmp (raw_result, "yes"))
1519 return Fcons (Qt, Qnil);
1520 return maybe_continuable_error
1522 "can't convert %s: %s to a Boolean", name_string, raw_result);
1524 else if (EQ (type, Qinteger) || EQ (type, Qnatnum))
1528 if (1 != sscanf (raw_result, "%d%c", &i, &c))
1529 return maybe_continuable_error
1531 "can't convert %s: %s to an integer", name_string, raw_result);
1532 else if (EQ (type, Qnatnum) && i < 0)
1533 return maybe_continuable_error
1535 "invalid numerical value %d for resource %s", i, name_string);
1537 return make_int (i);
1541 return maybe_signal_continuable_error
1542 (Qwrong_type_argument,
1543 list2 (build_translated_string
1544 ("should be string, integer, natnum or boolean"),
1550 DEFUN ("x-get-resource-prefix", Fx_get_resource_prefix, 1, 2, 0, /*
1551 Return the resource prefix for LOCALE on DEVICE.
1552 The resource prefix is the strings used to prefix resources if
1553 the LOCALE and DEVICE arguments were passed to `x-get-resource'.
1554 The returned value is a cons of a name prefix and a class prefix.
1555 For example, if LOCALE is a frame, the returned value might be
1556 \("xemacs.frame.FRAME-NAME" . "Emacs.EmacsLocaleType.EmacsFrame").
1557 If no valid X device for resourcing can be obtained, this function
1558 returns nil. (In such a case, `x-get-resource' would always return nil.)
1564 Dynarr_reset (name_char_dynarr );
1565 Dynarr_reset (class_char_dynarr);
1567 x_get_resource_prefix (locale, device, &display,
1568 name_char_dynarr, class_char_dynarr);
1572 return Fcons (make_string ((Bufbyte *) Dynarr_atp (name_char_dynarr, 0),
1573 Dynarr_length (name_char_dynarr)),
1574 make_string ((Bufbyte *) Dynarr_atp (class_char_dynarr, 0),
1575 Dynarr_length (class_char_dynarr)));
1578 DEFUN ("x-put-resource", Fx_put_resource, 1, 2, 0, /*
1579 Add a resource to the resource database for DEVICE.
1580 RESOURCE-LINE specifies the resource to add and should be a
1581 standard resource specification.
1583 (resource_line, device))
1585 struct device *d = decode_device (device);
1586 char *str, *colon_pos;
1588 CHECK_STRING (resource_line);
1589 str = (char *) XSTRING_DATA (resource_line);
1590 if (!(colon_pos = strchr (str, ':')) || strchr (str, '\n'))
1592 signal_simple_error ("Invalid resource line", resource_line);
1594 /* Only the following chars are allowed before the colon */
1595 " \t.*?abcdefghijklmnopqrstuvwxyz"
1596 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-")
1597 != (size_t) (colon_pos - str))
1602 XrmDatabase db = XtDatabase (DEVICE_X_DISPLAY (d));
1603 XrmPutLineResource (&db, str);
1610 /************************************************************************/
1611 /* display information functions */
1612 /************************************************************************/
1614 DEFUN ("default-x-device", Fdefault_x_device, 0, 0, 0, /*
1615 Return the default X device for resourcing.
1616 This is the first-created X device that still exists.
1620 return Vdefault_x_device;
1623 DEFUN ("x-display-visual-class", Fx_display_visual_class, 0, 1, 0, /*
1624 Return the visual class of the X display DEVICE is using.
1625 This can be altered from the default at startup using the XResource "EmacsVisual".
1626 The returned value will be one of the symbols `static-gray', `gray-scale',
1627 `static-color', `pseudo-color', `true-color', or `direct-color'.
1631 Visual *vis = DEVICE_X_VISUAL (decode_x_device (device));
1634 case StaticGray: return intern ("static-gray");
1635 case GrayScale: return intern ("gray-scale");
1636 case StaticColor: return intern ("static-color");
1637 case PseudoColor: return intern ("pseudo-color");
1638 case TrueColor: return intern ("true-color");
1639 case DirectColor: return intern ("direct-color");
1641 error ("display has an unknown visual class");
1642 return Qnil; /* suppress compiler warning */
1646 DEFUN ("x-display-visual-depth", Fx_display_visual_depth, 0, 1, 0, /*
1647 Return the bitplane depth of the visual the X display DEVICE is using.
1651 return make_int (DEVICE_X_DEPTH (decode_x_device (device)));
1655 x_device_system_metrics (struct device *d,
1656 enum device_metrics m)
1658 Display *dpy = DEVICE_X_DISPLAY (d);
1662 case DM_size_device:
1663 return Fcons (make_int (DisplayWidth (dpy, DefaultScreen (dpy))),
1664 make_int (DisplayHeight (dpy, DefaultScreen (dpy))));
1665 case DM_size_device_mm:
1666 return Fcons (make_int (DisplayWidthMM (dpy, DefaultScreen (dpy))),
1667 make_int (DisplayHeightMM (dpy, DefaultScreen (dpy))));
1668 case DM_num_bit_planes:
1669 return make_int (DisplayPlanes (dpy, DefaultScreen (dpy)));
1670 case DM_num_color_cells:
1671 return make_int (DisplayCells (dpy, DefaultScreen (dpy)));
1672 default: /* No such device metric property for X devices */
1677 DEFUN ("x-server-vendor", Fx_server_vendor, 0, 1, 0, /*
1678 Return the vendor ID string of the X server DEVICE is on.
1679 Return the empty string if the vendor ID string cannot be determined.
1683 Display *dpy = get_x_display (device);
1684 char *vendor = ServerVendor (dpy);
1686 return build_string (vendor ? vendor : "");
1689 DEFUN ("x-server-version", Fx_server_version, 0, 1, 0, /*
1690 Return the version numbers of the X server DEVICE is on.
1691 The returned value is a list of three integers: the major and minor
1692 version numbers of the X Protocol in use, and the vendor-specific release
1693 number. See also `x-server-vendor'.
1697 Display *dpy = get_x_display (device);
1699 return list3 (make_int (ProtocolVersion (dpy)),
1700 make_int (ProtocolRevision (dpy)),
1701 make_int (VendorRelease (dpy)));
1704 DEFUN ("x-valid-keysym-name-p", Fx_valid_keysym_name_p, 1, 1, 0, /*
1705 Return true if KEYSYM names a keysym that the X library knows about.
1706 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1707 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1711 const char *keysym_ext;
1713 CHECK_STRING (keysym);
1714 LISP_STRING_TO_EXTERNAL (keysym, keysym_ext, Qctext);
1716 return XStringToKeysym (keysym_ext) ? Qt : Qnil;
1719 DEFUN ("x-keysym-hash-table", Fx_keysym_hash_table, 0, 1, 0, /*
1720 Return a hash table containing a key for all keysyms on DEVICE.
1721 DEVICE must be an X11 display device. See `x-keysym-on-keyboard-p'.
1725 struct device *d = decode_device (device);
1726 if (!DEVICE_X_P (d))
1727 signal_simple_error ("Not an X device", device);
1729 return DEVICE_X_DATA (d)->x_keysym_map_hash_table;
1732 DEFUN ("x-keysym-on-keyboard-sans-modifiers-p", Fx_keysym_on_keyboard_sans_modifiers_p,
1734 Return true if KEYSYM names a key on the keyboard of DEVICE.
1735 More precisely, return true if pressing a physical key
1736 on the keyboard of DEVICE without any modifier keys generates KEYSYM.
1737 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1738 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1739 The keysym name can be provided in two forms:
1740 - if keysym is a string, it must be the name as known to X windows.
1741 - if keysym is a symbol, it must be the name as known to XEmacs.
1742 The two names differ in capitalization and underscoring.
1746 struct device *d = decode_device (device);
1747 if (!DEVICE_X_P (d))
1748 signal_simple_error ("Not an X device", device);
1750 return (EQ (Qsans_modifiers,
1751 Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ?
1756 DEFUN ("x-keysym-on-keyboard-p", Fx_keysym_on_keyboard_p, 1, 2, 0, /*
1757 Return true if KEYSYM names a key on the keyboard of DEVICE.
1758 More precisely, return true if some keystroke (possibly including modifiers)
1759 on the keyboard of DEVICE keys generates KEYSYM.
1760 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1761 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1762 The keysym name can be provided in two forms:
1763 - if keysym is a string, it must be the name as known to X windows.
1764 - if keysym is a symbol, it must be the name as known to XEmacs.
1765 The two names differ in capitalization and underscoring.
1769 struct device *d = decode_device (device);
1770 if (!DEVICE_X_P (d))
1771 signal_simple_error ("Not an X device", device);
1773 return (NILP (Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ?
1778 /************************************************************************/
1779 /* grabs and ungrabs */
1780 /************************************************************************/
1782 DEFUN ("x-grab-pointer", Fx_grab_pointer, 0, 3, 0, /*
1783 Grab the pointer and restrict it to its current window.
1784 If optional DEVICE argument is nil, the default device will be used.
1785 If optional CURSOR argument is non-nil, change the pointer shape to that
1786 until `x-ungrab-pointer' is called (it should be an object returned by the
1787 `make-cursor-glyph' function).
1788 If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all
1789 keyboard events during the grab.
1790 Returns t if the grab is successful, nil otherwise.
1792 (device, cursor, ignore_keyboard))
1795 int pointer_mode, result;
1796 struct device *d = decode_x_device (device);
1800 CHECK_POINTER_GLYPH (cursor);
1801 cursor = glyph_image_instance (cursor, device, ERROR_ME, 0);
1804 if (!NILP (ignore_keyboard))
1805 pointer_mode = GrabModeSync;
1807 pointer_mode = GrabModeAsync;
1809 w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d)));
1811 /* #### Possibly this needs to gcpro the cursor somehow, but it doesn't
1812 seem to cause a problem if XFreeCursor is called on a cursor in use
1813 in a grab; I suppose the X server counts the grab as a reference
1814 and doesn't free it until it exits? */
1815 result = XGrabPointer (DEVICE_X_DISPLAY (d), w,
1820 PointerMotionHintMask,
1821 GrabModeAsync, /* Keep pointer events flowing */
1822 pointer_mode, /* Stall keyboard events */
1823 w, /* Stay in this window */
1825 : XIMAGE_INSTANCE_X_CURSOR (cursor)),
1827 return (result == GrabSuccess) ? Qt : Qnil;
1830 DEFUN ("x-ungrab-pointer", Fx_ungrab_pointer, 0, 1, 0, /*
1831 Release a pointer grab made with `x-grab-pointer'.
1832 If optional first arg DEVICE is nil the default device is used.
1833 If it is t the pointer will be released on all X devices.
1837 if (!EQ (device, Qt))
1839 Display *dpy = get_x_display (device);
1840 XUngrabPointer (dpy, CurrentTime);
1844 Lisp_Object devcons, concons;
1846 DEVICE_LOOP_NO_BREAK (devcons, concons)
1848 struct device *d = XDEVICE (XCAR (devcons));
1851 XUngrabPointer (DEVICE_X_DISPLAY (d), CurrentTime);
1858 DEFUN ("x-grab-keyboard", Fx_grab_keyboard, 0, 1, 0, /*
1859 Grab the keyboard on the given device (defaulting to the selected one).
1860 So long as the keyboard is grabbed, all keyboard events will be delivered
1861 to emacs -- it is not possible for other X clients to eavesdrop on them.
1862 Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect).
1863 Returns t if the grab is successful, nil otherwise.
1867 struct device *d = decode_x_device (device);
1868 Window w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d)));
1869 Display *dpy = DEVICE_X_DISPLAY (d);
1872 status = XGrabKeyboard (dpy, w, True,
1873 /* I don't really understand sync-vs-async
1874 grabs, but this is what xterm does. */
1875 GrabModeAsync, GrabModeAsync,
1876 /* Use the timestamp of the last user action
1877 read by emacs proper; xterm uses CurrentTime
1878 but there's a comment that says "wrong"...
1879 (Despite the name this is the time of the
1880 last key or mouse event.) */
1881 DEVICE_X_MOUSE_TIMESTAMP (d));
1882 if (status == GrabSuccess)
1884 /* The XUngrabKeyboard should generate a FocusIn back to this
1885 window but it doesn't unless we explicitly set focus to the
1886 window first (which should already have it. The net result
1887 is that without this call when x-ungrab-keyboard is called
1888 the selected frame ends up not having focus. */
1889 XSetInputFocus (dpy, w, RevertToParent, DEVICE_X_MOUSE_TIMESTAMP (d));
1896 DEFUN ("x-ungrab-keyboard", Fx_ungrab_keyboard, 0, 1, 0, /*
1897 Release a keyboard grab made with `x-grab-keyboard'.
1901 Display *dpy = get_x_display (device);
1902 XUngrabKeyboard (dpy, CurrentTime);
1906 DEFUN ("x-get-font-path", Fx_get_font_path, 0, 1, 0, /*
1907 Get the X Server's font path.
1909 See also `x-set-font-path'.
1913 Display *dpy = get_x_display (device);
1915 const char **directories = (const char **) XGetFontPath (dpy, &ndirs_return);
1916 Lisp_Object font_path = Qnil;
1919 signal_simple_error ("Can't get X font path", device);
1921 while (ndirs_return--)
1922 font_path = Fcons (build_ext_string (directories[ndirs_return],
1929 DEFUN ("x-set-font-path", Fx_set_font_path, 1, 2, 0, /*
1930 Set the X Server's font path to FONT-PATH.
1932 There is only one font path per server, not one per client. Use this
1933 sparingly. It uncaches all of the X server's font information.
1935 Font directories should end in the path separator and should contain
1936 a file called fonts.dir usually created with the program mkfontdir.
1938 Setting the FONT-PATH to nil tells the X server to use the default
1941 See also `x-get-font-path'.
1943 (font_path, device))
1945 Display *dpy = get_x_display (device);
1946 Lisp_Object path_entry;
1947 const char **directories;
1950 EXTERNAL_LIST_LOOP (path_entry, font_path)
1952 CHECK_STRING (XCAR (path_entry));
1956 directories = alloca_array (const char *, ndirs);
1958 EXTERNAL_LIST_LOOP (path_entry, font_path)
1960 LISP_STRING_TO_EXTERNAL (XCAR (path_entry), directories[i++], Qfile_name);
1963 expect_x_error (dpy);
1964 XSetFontPath (dpy, (char **) directories, ndirs);
1965 signal_if_x_error (dpy, 1/*resumable_p*/);
1971 /************************************************************************/
1972 /* initialization */
1973 /************************************************************************/
1976 syms_of_device_x (void)
1978 DEFSUBR (Fx_debug_mode);
1979 DEFSUBR (Fx_get_resource);
1980 DEFSUBR (Fx_get_resource_prefix);
1981 DEFSUBR (Fx_put_resource);
1983 DEFSUBR (Fdefault_x_device);
1984 DEFSUBR (Fx_display_visual_class);
1985 DEFSUBR (Fx_display_visual_depth);
1986 DEFSUBR (Fx_server_vendor);
1987 DEFSUBR (Fx_server_version);
1988 DEFSUBR (Fx_valid_keysym_name_p);
1989 DEFSUBR (Fx_keysym_hash_table);
1990 DEFSUBR (Fx_keysym_on_keyboard_p);
1991 DEFSUBR (Fx_keysym_on_keyboard_sans_modifiers_p);
1993 DEFSUBR (Fx_grab_pointer);
1994 DEFSUBR (Fx_ungrab_pointer);
1995 DEFSUBR (Fx_grab_keyboard);
1996 DEFSUBR (Fx_ungrab_keyboard);
1998 DEFSUBR (Fx_get_font_path);
1999 DEFSUBR (Fx_set_font_path);
2001 defsymbol (&Qx_error, "x-error");
2002 defsymbol (&Qinit_pre_x_win, "init-pre-x-win");
2003 defsymbol (&Qinit_post_x_win, "init-post-x-win");
2007 reinit_console_type_create_device_x (void)
2009 /* Initialize variables to speed up X resource interactions */
2010 const char *valid_resource_chars =
2011 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_";
2012 while (*valid_resource_chars)
2013 valid_resource_char_p[(unsigned int) (*valid_resource_chars++)] = 1;
2015 name_char_dynarr = Dynarr_new (char);
2016 class_char_dynarr = Dynarr_new (char);
2020 console_type_create_device_x (void)
2022 reinit_console_type_create_device_x ();
2023 CONSOLE_HAS_METHOD (x, init_device);
2024 CONSOLE_HAS_METHOD (x, finish_init_device);
2025 CONSOLE_HAS_METHOD (x, mark_device);
2026 CONSOLE_HAS_METHOD (x, delete_device);
2027 CONSOLE_HAS_METHOD (x, device_system_metrics);
2031 reinit_vars_of_device_x (void)
2036 in_resource_setting = 0;
2040 vars_of_device_x (void)
2042 reinit_vars_of_device_x ();
2044 DEFVAR_LISP ("x-emacs-application-class", &Vx_emacs_application_class /*
2045 The X application class of the XEmacs process.
2046 This controls, among other things, the name of the `app-defaults' file
2047 that XEmacs will use. For changes to this variable to take effect, they
2048 must be made before the connection to the X server is initialized, that is,
2049 this variable may only be changed before emacs is dumped, or by setting it
2050 in the file lisp/term/x-win.el.
2052 If this variable is nil before the connection to the X server is first
2053 initialized (which it is by default), the X resource database will be
2054 consulted and the value will be set according to whether any resources
2055 are found for the application class `XEmacs'. If the user has set any
2056 resources for the XEmacs application class, the XEmacs process will use
2057 the application class `XEmacs'. Otherwise, the XEmacs process will use
2058 the application class `Emacs' which is backwards compatible to previous
2059 XEmacs versions but may conflict with resources intended for GNU Emacs.
2061 Vx_emacs_application_class = Qnil;
2063 DEFVAR_LISP ("x-initial-argv-list", &Vx_initial_argv_list /*
2064 You don't want to know.
2065 This is used during startup to communicate the remaining arguments in
2066 `command-line-args-left' to the C code, which passes the args to
2067 the X initialization code, which removes some args, and then the
2068 args are placed back into `x-initial-arg-list' and thence into
2069 `command-line-args-left'. Perhaps `command-line-args-left' should
2072 Vx_initial_argv_list = Qnil;
2074 #if defined(MULE) && (defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET))
2075 DEFVAR_LISP ("x-app-defaults-directory", &Vx_app_defaults_directory /*
2076 Used by the Lisp code to communicate to the low level X initialization
2077 where the localized init files are.
2079 Vx_app_defaults_directory = Qnil;
2084 staticpro (&Vdefault_x_device);
2085 Vdefault_x_device = Qnil;