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 /* Original authors: Jamie Zawinski and the FSF */
25 /* Rewritten by Ben Wing and Chuck Thompson. */
30 #include "console-x.h"
31 #include "xintrinsicp.h" /* CoreP.h needs this */
32 #include <X11/CoreP.h> /* Numerous places access the fields of
33 a core widget directly. We could
34 use XtGetValues(), but ... */
36 #include <X11/Shell.h>
39 #include "objects-x.h"
46 #include "redisplay.h"
53 #if defined(HAVE_SHLIB) && defined(LWLIB_USES_ATHENA) && !defined(HAVE_ATHENA_3D)
55 #endif /* HAVE_SHLIB and LWLIB_USES_ATHENA and not HAVE_ATHENA_3D */
61 Lisp_Object Vdefault_x_device;
62 #if defined(MULE) && (defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET))
63 Lisp_Object Vx_app_defaults_directory;
66 /* Qdisplay in general.c */
68 Lisp_Object Qinit_pre_x_win, Qinit_post_x_win;
70 /* The application class of Emacs. */
71 Lisp_Object Vx_emacs_application_class;
73 Lisp_Object Vx_initial_argv_list; /* #### ugh! */
75 static XrmOptionDescRec emacs_options[] =
77 {"-geometry", ".geometry", XrmoptionSepArg, NULL},
78 {"-iconic", ".iconic", XrmoptionNoArg, "yes"},
80 {"-internal-border-width", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL},
81 {"-ib", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL},
82 {"-scrollbar-width", "*EmacsFrame.scrollBarWidth", XrmoptionSepArg, NULL},
83 {"-scrollbar-height", "*EmacsFrame.scrollBarHeight", XrmoptionSepArg, NULL},
85 {"-privatecolormap", ".privateColormap", XrmoptionNoArg, "yes"},
86 {"-visual", ".EmacsVisual", XrmoptionSepArg, NULL},
88 /* #### Beware! If the type of the shell changes, update this. */
89 {"-T", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
90 {"-wn", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
91 {"-title", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
93 {"-iconname", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL},
94 {"-in", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL},
95 {"-mc", "*pointerColor", XrmoptionSepArg, NULL},
96 {"-cr", "*cursorColor", XrmoptionSepArg, NULL},
97 {"-fontset", "*FontSet", XrmoptionSepArg, NULL},
100 /* Functions to synchronize mirroring resources and specifiers */
101 int in_resource_setting;
103 /************************************************************************/
104 /* helper functions */
105 /************************************************************************/
107 /* JH 97/11/25 removed the static declaration because I need it during setup in event-Xt... */
108 struct device * get_device_from_display_1 (Display *dpy);
110 get_device_from_display_1 (Display *dpy)
112 Lisp_Object devcons, concons;
114 DEVICE_LOOP_NO_BREAK (devcons, concons)
116 struct device *d = XDEVICE (XCAR (devcons));
117 if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d) == dpy)
125 get_device_from_display (Display *dpy)
127 struct device *d = get_device_from_display_1 (dpy);
129 #if !defined(INFODOCK)
130 # define FALLBACK_RESOURCE_NAME "xemacs"
132 # define FALLBACK_RESOURCE_NAME "infodock"
136 /* This isn't one of our displays. Let's crash? */
138 ("\n%s: Fatal X Condition. Asked about display we don't own: \"%s\"\n",
139 (STRINGP (Vinvocation_name) ?
140 (char *) XSTRING_DATA (Vinvocation_name) : FALLBACK_RESOURCE_NAME),
141 DisplayString (dpy) ? DisplayString (dpy) : "???");
145 #undef FALLBACK_RESOURCE_NAME
151 decode_x_device (Lisp_Object device)
153 XSETDEVICE (device, decode_device (device));
154 CHECK_X_DEVICE (device);
155 return XDEVICE (device);
159 get_x_display (Lisp_Object device)
161 return DEVICE_X_DISPLAY (decode_x_device (device));
165 /************************************************************************/
166 /* initializing an X connection */
167 /************************************************************************/
170 allocate_x_device_struct (struct device *d)
172 d->device_data = xnew_and_zero (struct x_device);
176 Xatoms_of_device_x (struct device *d)
178 Display *D = DEVICE_X_DISPLAY (d);
180 DEVICE_XATOM_WM_PROTOCOLS (d) = XInternAtom (D, "WM_PROTOCOLS", False);
181 DEVICE_XATOM_WM_DELETE_WINDOW(d) = XInternAtom (D, "WM_DELETE_WINDOW",False);
182 DEVICE_XATOM_WM_SAVE_YOURSELF(d) = XInternAtom (D, "WM_SAVE_YOURSELF",False);
183 DEVICE_XATOM_WM_TAKE_FOCUS (d) = XInternAtom (D, "WM_TAKE_FOCUS", False);
184 DEVICE_XATOM_WM_STATE (d) = XInternAtom (D, "WM_STATE", False);
188 sanity_check_geometry_resource (Display *dpy)
190 char *app_name, *app_class, *s;
191 char buf1 [255], buf2 [255];
194 XtGetApplicationNameAndClass (dpy, &app_name, &app_class);
195 strcpy (buf1, app_name);
196 strcpy (buf2, app_class);
197 for (s = buf1; *s; s++) if (*s == '.') *s = '_';
198 strcat (buf1, "._no_._such_._resource_.geometry");
199 strcat (buf2, "._no_._such_._resource_.Geometry");
200 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)
202 warn_when_safe (Qgeometry, Qerror,
204 "Apparently \"%s*geometry: %s\" or \"%s*geometry: %s\" was\n"
205 "specified in the resource database. Specifying \"*geometry\" will make\n"
206 "XEmacs (and most other X programs) malfunction in obscure ways. (i.e.\n"
207 "the Xt or Xm libraries will probably crash, which is a very bad thing.)\n"
208 "You should always use \".geometry\" or \"*EmacsFrame.geometry\" instead.\n",
209 app_name, (char *) value.addr,
210 app_class, (char *) value.addr);
211 suppress_early_error_handler_backtrace = 1;
212 error ("Invalid geometry resource");
217 x_init_device_class (struct device *d)
219 if (DEVICE_X_DEPTH(d) > 2)
221 switch (DEVICE_X_VISUAL(d)->class)
225 DEVICE_CLASS (d) = Qgrayscale;
228 DEVICE_CLASS (d) = Qcolor;
232 DEVICE_CLASS (d) = Qmono;
236 * Figure out what application name to use for xemacs
238 * Since we have decomposed XtOpenDisplay into XOpenDisplay and
239 * XtDisplayInitialize, we no longer get this for free.
241 * If there is a `-name' argument in argv, use that.
242 * Otherwise use the last component of argv[0].
244 * I have removed the gratuitous use of getenv("RESOURCE_NAME")
245 * which was in X11R5, but left the matching of any prefix of `-name'.
246 * Finally, if all else fails, return `xemacs', as it is more
247 * appropriate (X11R5 returns `main').
250 compute_x_app_name (int argc, char **argv)
255 for (i = 1; i < argc - 1; i++)
256 if (!strncmp(argv[i], "-name", max (2, strlen (argv[1]))))
259 if (argc > 0 && argv[0] && *argv[0])
260 return (ptr = strrchr (argv[0], '/')) ? ++ptr : argv[0];
266 * This function figures out whether the user has any resources of the
267 * form "XEmacs.foo" or "XEmacs*foo".
269 * Currently we only consult the display's global resources; to look
270 * for screen specific resources, we would need to also consult:
271 * xdefs = XScreenResourceString(ScreenOfDisplay(dpy, scrno));
274 have_xemacs_resources_in_xrdb (Display *dpy)
289 xdefs = XResourceManagerString (dpy); /* don't free - owned by X */
290 while (xdefs && *xdefs)
292 if (strncmp (xdefs, key, len) == 0 &&
293 (xdefs[len] == '*' || xdefs[len] == '.'))
296 while (*xdefs && *xdefs++ != '\n') /* find start of next entry.. */
303 /* Only the characters [-_A-Za-z0-9] are allowed in the individual
304 components of a resource. Convert invalid characters to `-' */
306 static char valid_resource_char_p[256];
309 validify_resource_component (char *str, size_t len)
311 for (; len; len--, str++)
312 if (!valid_resource_char_p[(unsigned char) (*str)])
317 Dynarr_add_validified_lisp_string (char_dynarr *cda, Lisp_Object str)
319 Bytecount len = XSTRING_LENGTH (str);
320 Dynarr_add_many (cda, (char *) XSTRING_DATA (str), len);
321 validify_resource_component (Dynarr_atp (cda, Dynarr_length (cda) - len), len);
325 /* compare visual info for qsorting */
327 x_comp_visual_info (const void *elem1, const void *elem2)
329 XVisualInfo *left, *right;
331 left = (XVisualInfo *)elem1;
332 right = (XVisualInfo *)elem2;
339 if ( left->depth > right->depth ) {
342 else if ( left->depth == right->depth ) {
343 if ( left->colormap_size > right->colormap_size )
345 if ( left->class > right->class )
347 else if ( left->class < right->class )
359 #define XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN
361 x_try_best_visual_class (Screen *screen, int scrnum, int visual_class)
363 Display *dpy = DisplayOfScreen (screen);
365 XVisualInfo *vi_out = NULL;
368 vi_in.class = visual_class;
369 vi_in.screen = scrnum;
370 vi_out = XGetVisualInfo (dpy, (VisualClassMask | VisualScreenMask),
376 for (i = 0, best = 0; i < out_count; i++)
377 /* It's better if it's deeper, or if it's the same depth with
378 more cells (does that ever happen? Well, it could...)
379 NOTE: don't allow pseudo color to get larger than 8! */
380 if (((vi_out [i].depth > vi_out [best].depth) ||
381 ((vi_out [i].depth == vi_out [best].depth) &&
382 (vi_out [i].colormap_size > vi_out [best].colormap_size)))
383 #ifdef XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN
384 /* For now, the image library doesn't like PseudoColor visuals
385 of depths other than 1 or 8. Depths greater than 8 only occur
386 on machines which have TrueColor anyway, so probably we'll end
387 up using that (it is the one that `Best' would pick) but if a
388 PseudoColor visual is explicitly specified, pick the 8 bit one.
390 && (visual_class != PseudoColor ||
391 vi_out [i].depth == 1 ||
392 vi_out [i].depth == 8)
395 /* SGI has 30-bit deep visuals. Ignore them.
396 (We only have 24-bit data anyway.)
398 && (vi_out [i].depth <= 24)
401 visual = vi_out[best].visual;
402 XFree ((char *) vi_out);
410 x_get_visual_depth (Display *dpy, Visual *visual)
416 vi_in.visualid = XVisualIDFromVisual (visual);
417 vi_out = XGetVisualInfo (dpy, /*VisualScreenMask|*/VisualIDMask,
419 if (! vi_out) abort ();
420 d = vi_out [0].depth;
421 XFree ((char *) vi_out);
426 x_try_best_visual (Display *dpy, int scrnum)
428 Visual *visual = NULL;
429 Screen *screen = ScreenOfDisplay (dpy, scrnum);
430 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor))
431 && x_get_visual_depth (dpy, visual) >= 16 )
433 if ((visual = x_try_best_visual_class (screen, scrnum, PseudoColor)))
435 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor)))
437 #ifdef DIRECTCOLOR_WORKS
438 if ((visual = x_try_best_visual_class (screen, scrnum, DirectColor)))
442 visual = DefaultVisualOfScreen (screen);
443 if ( x_get_visual_depth (dpy, visual) >= 8 )
446 if ((visual = x_try_best_visual_class (screen, scrnum, StaticGray)))
448 if ((visual = x_try_best_visual_class (screen, scrnum, GrayScale)))
450 return DefaultVisualOfScreen (screen);
455 x_init_device (struct device *d, Lisp_Object props)
463 const char *app_class;
464 const char *app_name;
465 const char *disp_name;
466 Visual *visual = NULL;
467 int depth = 8; /* shut up the compiler */
471 int best_visual_found = 0;
473 #if defined(HAVE_SHLIB) && defined(LWLIB_USES_ATHENA) && !defined(HAVE_ATHENA_3D)
475 * In order to avoid the lossage with flat Athena widgets dynamically
476 * linking to one of the ThreeD variants, using the dynamic symbol helpers
477 * to look for symbols that shouldn't be there and refusing to run if they
478 * are seems a less toxic idea than having XEmacs crash when we try and
479 * use a subclass of a widget that has changed size.
481 * It's ugly, I know, and not going to work everywhere. It seems better to
482 * do our damnedest to try and tell the user what to expect rather than
483 * simply blow up though.
485 * All the ThreeD variants I have access to define the following function
486 * symbols in the shared library. The flat Xaw library does not define them:
488 * Xaw3dComputeBottomShadowRGB
489 * Xaw3dComputeTopShadowRGB
491 * So far only Linux has shown this problem. This seems to be portable to
492 * all the distributions (certainly all the ones I checked - Debian and
495 * This will only work, sadly, with dlopen() -- the other dynamic linkers
496 * are simply not capable of doing what is needed. :/
500 /* Get a dll handle to the main process. */
501 dll_handle xaw_dll_handle = dll_open (NULL);
503 /* Did that fail? If so, continue without error.
504 * We could die here but, well, that's unfriendly and all -- plus I feel
505 * better about some crashing somewhere rather than preventing a perfectly
506 * good configuration working just because dll_open failed.
508 if (xaw_dll_handle != NULL)
510 /* Look for the Xaw3d function */
511 dll_func xaw_function_handle =
512 dll_function (xaw_dll_handle, "Xaw3dComputeTopShadowRGB");
514 /* If we found it, warn the user in big, nasty, unfriendly letters */
515 if (xaw_function_handle != NULL)
517 warn_when_safe (Qdevice, Qerror, "\n"
518 "It seems that XEmacs is built dynamically linked to the flat Athena widget\n"
519 "library but it finds a 3D Athena variant with the same name at runtime.\n"
521 "This WILL cause your XEmacs process to dump core at some point.\n"
522 "You should not continue to use this binary without resolving this issue.\n"
524 "This can be solved with the xaw-wrappers package under Debian\n"
525 "(register XEmacs as incompatible with all 3d widget sets, see\n"
526 "update-xaw-wrappers(8) and .../doc/xaw-wrappers/README.packagers). It\n"
527 "can be verified by checking the runtime path in /etc/ld.so.conf and by\n"
528 "using `ldd /path/to/xemacs' under other Linux distributions. One\n"
529 "solution is to use LD_PRELOAD or LD_LIBRARY_PATH to force ld.so to\n"
530 "load the flat Athena widget library instead of the aliased 3D widget\n"
531 "library (see ld.so(8) for use of these environment variables).\n\n"
536 /* Otherwise release the handle to the library
537 * No error catch here; I can't think of a way to recover anyhow.
539 dll_close (xaw_dll_handle);
542 #endif /* HAVE_SHLIB and LWLIB_USES_ATHENA and not HAVE_ATHENA_3D */
545 XSETDEVICE (device, d);
546 display = DEVICE_CONNECTION (d);
548 allocate_x_device_struct (d);
550 make_argc_argv (Vx_initial_argv_list, &argc, &argv);
552 TO_EXTERNAL_FORMAT (LISP_STRING, display,
553 C_STRING_ALLOCA, disp_name,
557 * Break apart the old XtOpenDisplay call into XOpenDisplay and
558 * XtDisplayInitialize so we can figure out whether there
559 * are any XEmacs resources in the resource database before
560 * we initialize Xt. This is so we can automagically support
561 * both `Emacs' and `XEmacs' application classes.
563 slow_down_interrupts ();
564 /* May not be needed but XtOpenDisplay could not deal with signals here. */
565 dpy = DEVICE_X_DISPLAY (d) = XOpenDisplay (disp_name);
566 speed_up_interrupts ();
570 suppress_early_error_handler_backtrace = 1;
571 signal_simple_error ("X server not responding\n", display);
574 if (STRINGP (Vx_emacs_application_class) &&
575 XSTRING_LENGTH (Vx_emacs_application_class) > 0)
576 TO_EXTERNAL_FORMAT (LISP_STRING, Vx_emacs_application_class,
577 C_STRING_ALLOCA, app_class,
581 app_class = (NILP (Vx_emacs_application_class) &&
582 have_xemacs_resources_in_xrdb (dpy))
589 /* need to update Vx_emacs_application_class: */
590 Vx_emacs_application_class = build_string (app_class);
593 slow_down_interrupts ();
594 /* May not be needed but XtOpenDisplay could not deal with signals here.
596 XtDisplayInitialize (Xt_app_con, dpy, compute_x_app_name (argc, argv),
597 app_class, emacs_options,
598 XtNumber (emacs_options), &argc, argv);
599 speed_up_interrupts ();
601 screen = DefaultScreen (dpy);
602 if (NILP (Vdefault_x_device))
603 Vdefault_x_device = device;
606 #if defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET)
608 /* Read in locale-specific resources from
609 data-directory/app-defaults/$LANG/Emacs.
610 This is in addition to the standard app-defaults files, and
611 does not override resources defined elsewhere */
612 const char *data_dir;
614 XrmDatabase db = XtDatabase (dpy); /* #### XtScreenDatabase(dpy) ? */
615 const char *locale = XrmLocaleOfDatabase (db);
617 if (STRINGP (Vx_app_defaults_directory) &&
618 XSTRING_LENGTH (Vx_app_defaults_directory) > 0)
620 TO_EXTERNAL_FORMAT (LISP_STRING, Vx_app_defaults_directory,
621 C_STRING_ALLOCA, data_dir,
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 TO_EXTERNAL_FORMAT (LISP_STRING, Vdata_directory,
631 C_STRING_ALLOCA, data_dir,
633 path = (char *)alloca (strlen (data_dir) + 13 + strlen (locale) + 7);
634 sprintf (path, "%sapp-defaults/%s/Emacs", data_dir, locale);
635 if (!access (path, R_OK))
636 XrmCombineFileDatabase (path, &db, False);
639 #endif /* LWLIB_MENUBARS_MOTIF or HAVE_XIM USE_XFONTSET */
642 if (NILP (DEVICE_NAME (d)))
643 DEVICE_NAME (d) = display;
645 /* We're going to modify the string in-place, so be a nice XEmacs */
646 DEVICE_NAME (d) = Fcopy_sequence (DEVICE_NAME (d));
647 /* colons and periods can't appear in individual elements of resource
650 XtGetApplicationNameAndClass (dpy, (char **) &app_name, (char **) &app_class);
651 /* search for a matching visual if requested by the user, or setup the display default */
653 int resource_name_length = max (sizeof (".emacsVisual"),
654 sizeof (".privateColormap"));
655 char *buf1 = alloca_array (char, strlen (app_name) + resource_name_length);
656 char *buf2 = alloca_array (char, strlen (app_class) + resource_name_length);
660 sprintf (buf1, "%s.emacsVisual", app_name);
661 sprintf (buf2, "%s.EmacsVisual", app_class);
662 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)
665 int vis_class = PseudoColor;
667 char *str = (char*) value.addr;
669 #define CHECK_VIS_CLASS(visual_class) \
670 else if (memcmp (str, #visual_class, sizeof (#visual_class) - 1) == 0) \
671 cnt = sizeof (#visual_class) - 1, vis_class = visual_class
675 CHECK_VIS_CLASS (StaticGray);
676 CHECK_VIS_CLASS (StaticColor);
677 CHECK_VIS_CLASS (TrueColor);
678 CHECK_VIS_CLASS (GrayScale);
679 CHECK_VIS_CLASS (PseudoColor);
680 CHECK_VIS_CLASS (DirectColor);
684 depth = atoi (str + cnt);
687 stderr_out ("Invalid Depth specification in %s... ignoring...\n", str);
691 if (XMatchVisualInfo (dpy, screen, depth, vis_class, &vinfo))
693 visual = vinfo.visual;
697 stderr_out ("Can't match the requested visual %s... using defaults\n", str);
703 stderr_out( "Invalid Visual specification in %s... ignoring.\n", str);
709 visual = DefaultVisual(dpy, screen);
710 depth = DefaultDepth(dpy, screen);
712 visual = x_try_best_visual (dpy, screen);
713 depth = x_get_visual_depth (dpy, visual);
714 best_visual_found = (visual != DefaultVisual (dpy, screen));
717 /* If we've got the same visual as the default and it's PseudoColor,
718 check to see if the user specified that we need a private colormap */
719 if (visual == DefaultVisual (dpy, screen))
721 sprintf (buf1, "%s.privateColormap", app_name);
722 sprintf (buf2, "%s.PrivateColormap", app_class);
723 if ((visual->class == PseudoColor) &&
724 (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True))
726 cmap = XCopyColormapAndFree (dpy, DefaultColormap (dpy, screen));
730 cmap = DefaultColormap (dpy, screen);
735 if ( best_visual_found )
737 cmap = XCreateColormap (dpy, RootWindow (dpy, screen), visual, AllocNone);
741 /* We have to create a matching colormap anyway...
742 #### think about using standard colormaps (need the Xmu libs?) */
743 cmap = XCreateColormap(dpy, RootWindow(dpy, screen), visual, AllocNone);
744 XInstallColormap(dpy, cmap);
749 DEVICE_X_VISUAL (d) = visual;
750 DEVICE_X_COLORMAP (d) = cmap;
751 DEVICE_X_DEPTH (d) = depth;
752 validify_resource_component ((char *) XSTRING_DATA (DEVICE_NAME (d)),
753 XSTRING_LENGTH (DEVICE_NAME (d)));
757 XtSetArg (al[0], XtNvisual, visual);
758 XtSetArg (al[1], XtNdepth, depth);
759 XtSetArg (al[2], XtNcolormap, cmap);
761 app_shell = XtAppCreateShell (NULL, app_class,
762 applicationShellWidgetClass,
763 dpy, al, countof (al));
766 DEVICE_XT_APP_SHELL (d) = app_shell;
770 #endif /* HAVE_XIM */
772 /* Realize the app_shell so that its window exists for GC creation purposes,
773 and set it to the size of the root window for child placement purposes */
776 XtSetArg (al[0], XtNmappedWhenManaged, False);
777 XtSetArg (al[1], XtNx, 0);
778 XtSetArg (al[2], XtNy, 0);
779 XtSetArg (al[3], XtNwidth, WidthOfScreen (ScreenOfDisplay (dpy, screen)));
780 XtSetArg (al[4], XtNheight, HeightOfScreen (ScreenOfDisplay (dpy, screen)));
781 XtSetValues (app_shell, al, countof (al));
782 XtRealizeWidget (app_shell);
785 #ifdef HAVE_WMCOMMAND
789 make_argc_argv (Vcommand_line_args, &new_argc, &new_argv);
790 XSetCommand (XtDisplay (app_shell), XtWindow (app_shell), new_argv, new_argc);
791 free_argc_argv (new_argv);
793 #endif /* HAVE_WMCOMMAND */
796 #ifdef HAVE_OFFIX_DND
797 DndInitialize ( app_shell );
800 Vx_initial_argv_list = make_arg_list (argc, argv);
801 free_argc_argv (argv);
803 DEVICE_X_WM_COMMAND_FRAME (d) = Qnil;
805 sanity_check_geometry_resource (dpy);
808 x_init_modifier_mapping (d);
810 DEVICE_INFD (d) = DEVICE_OUTFD (d) = ConnectionNumber (dpy);
814 DEVICE_X_GC_CACHE (d) = make_gc_cache (dpy, XtWindow(app_shell));
815 DEVICE_X_GRAY_PIXMAP (d) = None;
816 Xatoms_of_device_x (d);
817 Xatoms_of_select_x (d);
818 Xatoms_of_objects_x (d);
819 x_init_device_class (d);
821 /* Run the elisp side of the X device initialization. */
822 call0 (Qinit_pre_x_win);
826 x_finish_init_device (struct device *d, Lisp_Object props)
828 call0 (Qinit_post_x_win);
832 x_mark_device (struct device *d)
834 mark_object (DEVICE_X_WM_COMMAND_FRAME (d));
835 mark_object (DEVICE_X_DATA (d)->x_keysym_map_hash_table);
839 /************************************************************************/
840 /* closing an X connection */
841 /************************************************************************/
844 free_x_device_struct (struct device *d)
846 xfree (d->device_data);
850 x_delete_device (struct device *d)
855 extern void (*__free_hook) (void *);
859 XSETDEVICE (device, d);
860 display = DEVICE_X_DISPLAY (d);
865 checking_free = (__free_hook != 0);
867 /* Disable strict free checking, to avoid bug in X library */
869 disable_strict_free_check ();
872 free_gc_cache (DEVICE_X_GC_CACHE (d));
873 if (DEVICE_X_DATA (d)->x_modifier_keymap)
874 XFreeModifiermap (DEVICE_X_DATA (d)->x_modifier_keymap);
875 if (DEVICE_X_DATA (d)->x_keysym_map)
876 XFree ((char *) DEVICE_X_DATA (d)->x_keysym_map);
878 if (DEVICE_XT_APP_SHELL (d))
880 XtDestroyWidget (DEVICE_XT_APP_SHELL (d));
881 DEVICE_XT_APP_SHELL (d) = NULL;
884 XtCloseDisplay (display);
885 DEVICE_X_DISPLAY (d) = 0;
888 enable_strict_free_check ();
892 if (EQ (device, Vdefault_x_device))
894 Lisp_Object devcons, concons;
895 /* #### handle deleting last X device */
896 Vdefault_x_device = Qnil;
897 DEVICE_LOOP_NO_BREAK (devcons, concons)
899 if (DEVICE_X_P (XDEVICE (XCAR (devcons))) &&
900 !EQ (device, XCAR (devcons)))
902 Vdefault_x_device = XCAR (devcons);
908 free_x_device_struct (d);
912 /************************************************************************/
913 /* handle X errors */
914 /************************************************************************/
917 x_event_name (int event_type)
919 static const char *events[] =
959 if (event_type < 0 || event_type >= countof (events))
961 return events [event_type];
966 If an X error occurs which we are not expecting, we have no alternative
967 but to print it to stderr. It would be nice to stuff it into a pop-up
968 buffer, or to print it in the minibuffer, but that's not possible, because
969 one is not allowed to do any I/O on the display connection from an error
970 handler. The guts of Xlib expect these functions to either return or exit.
972 However, there are occasions when we might expect an error to reasonably
973 occur. The interface to this is as follows:
975 Before calling some X routine which may error, call
976 expect_x_error (dpy);
978 Just after calling the X routine, call either:
980 x_error_occurred_p (dpy);
982 to ask whether an error happened (and was ignored), or:
984 signal_if_x_error (dpy, resumable_p);
986 which will call Fsignal() with args appropriate to the X error, if there
987 was one. (Resumable_p is whether the debugger should be allowed to
988 continue from the call to signal.)
990 You must call one of these two routines immediately after calling the X
991 routine; think of them as bookends like BLOCK_INPUT and UNBLOCK_INPUT.
994 static int error_expected;
995 static int error_occurred;
996 static XErrorEvent last_error;
1000 #ifdef EXTERNAL_WIDGET
1002 x_error_handler_do_enqueue (Lisp_Object frame)
1004 enqueue_magic_eval_event (io_error_delete_frame, frame);
1009 x_error_handler_error (Lisp_Object data, Lisp_Object dummy)
1013 #endif /* EXTERNAL_WIDGET */
1016 x_error_handler (Display *disp, XErrorEvent *event)
1022 last_error = *event;
1026 #ifdef EXTERNAL_WIDGET
1028 struct device *d = get_device_from_display (disp);
1030 if ((event->error_code == BadWindow ||
1031 event->error_code == BadDrawable)
1032 && ((f = x_any_window_to_frame (d, event->resourceid)) != 0))
1036 /* one of the windows comprising one of our frames has died.
1037 This occurs particularly with ExternalShell frames when the
1038 client that owns the ExternalShell's window dies.
1040 We cannot do any I/O on the display connection so we need
1041 to enqueue an eval event so that the deletion happens
1044 Furthermore, we need to trap any errors (out-of-memory) that
1045 may occur when Fenqueue_eval_event is called.
1048 if (f->being_deleted)
1050 XSETFRAME (frame, f);
1051 if (!NILP (condition_case_1 (Qerror, x_error_handler_do_enqueue,
1052 frame, x_error_handler_error, Qnil)))
1054 f->being_deleted = 1;
1059 #endif /* EXTERNAL_WIDGET */
1061 stderr_out ("\n%s: ",
1062 (STRINGP (Vinvocation_name)
1063 ? (char *) XSTRING_DATA (Vinvocation_name)
1065 XmuPrintDefaultErrorMessage (disp, event, stderr);
1071 expect_x_error (Display *dpy)
1073 assert (!error_expected);
1074 XSync (dpy, 0); /* handle pending errors before setting flag */
1080 x_error_occurred_p (Display *dpy)
1083 XSync (dpy, 0); /* handle pending errors before setting flag */
1084 val = error_occurred;
1091 signal_if_x_error (Display *dpy, int resumable_p)
1095 if (! x_error_occurred_p (dpy))
1098 sprintf (buf, "0x%X", (unsigned int) last_error.resourceid);
1099 data = Fcons (build_string (buf), data);
1102 sprintf (num, "%d", last_error.request_code);
1103 XGetErrorDatabaseText (last_error.display, "XRequest", num, "",
1106 sprintf (buf, "Request-%d", last_error.request_code);
1107 data = Fcons (build_string (buf), data);
1109 XGetErrorText (last_error.display, last_error.error_code, buf, sizeof (buf));
1110 data = Fcons (build_string (buf), data);
1112 Fsignal (Qx_error, data);
1113 if (! resumable_p) goto again;
1118 x_IO_error_handler (Display *disp)
1120 /* This function can GC */
1122 struct device *d = get_device_from_display_1 (disp);
1125 XSETDEVICE (dev, d);
1127 if (NILP (find_nonminibuffer_frame_not_on_device (dev)))
1129 /* We're going down. */
1131 ("\n%s: Fatal I/O Error %d (%s) on display connection \"%s\"\n",
1132 (STRINGP (Vinvocation_name) ?
1133 (char *) XSTRING_DATA (Vinvocation_name) : "xemacs"),
1134 errno, strerror (errno), DisplayString (disp));
1136 (" after %lu requests (%lu known processed) with %d events remaining.\n",
1137 NextRequest (disp) - 1, LastKnownRequestProcessed (disp),
1139 /* assert (!_Xdebug); */
1145 "I/O Error %d (%s) on display connection\n"
1146 " \"%s\" after after %lu requests (%lu known processed)\n"
1147 " with %d events remaining.\n"
1148 " Throwing to top level.\n",
1149 errno, strerror (errno), DisplayString (disp),
1150 NextRequest (disp) - 1, LastKnownRequestProcessed (disp),
1154 /* According to X specs, we should not return from this function, or
1155 Xlib might just decide to exit(). So we mark the offending
1156 console for deletion and throw to top level. */
1158 enqueue_magic_eval_event (io_error_delete_device, dev);
1159 DEVICE_X_BEING_DELETED (d) = 1;
1160 Fthrow (Qtop_level, Qnil);
1162 return 0; /* not reached */
1165 DEFUN ("x-debug-mode", Fx_debug_mode, 1, 2, 0, /*
1166 With a true arg, make the connection to the X server synchronous.
1167 With false, make it asynchronous. Synchronous connections are much slower,
1168 but are useful for debugging. (If you get X errors, make the connection
1169 synchronous, and use a debugger to set a breakpoint on `x_error_handler'.
1170 Your backtrace of the C stack will now be useful. In asynchronous mode,
1171 the stack above `x_error_handler' isn't helpful because of buffering.)
1172 If DEVICE is not specified, the selected device is assumed.
1174 Calling this function is the same as calling the C function `XSynchronize',
1175 or starting the program with the `-sync' command line argument.
1179 struct device *d = decode_x_device (device);
1181 XSynchronize (DEVICE_X_DISPLAY (d), !NILP (arg));
1184 message ("X connection is synchronous");
1186 message ("X connection is asynchronous");
1192 /************************************************************************/
1194 /************************************************************************/
1196 #if 0 /* bah humbug. The whole "widget == resource" stuff is such
1197 a crock of shit that I'm just going to ignore it all. */
1199 /* If widget is NULL, we are retrieving device or global face data. */
1202 construct_name_list (Display *display, Widget widget, char *fake_name,
1203 char *fake_class, char *name, char *class)
1205 char *stack [100][2];
1208 char *name_tail, *class_tail;
1212 for (this = widget; this; this = XtParent (this))
1214 stack [count][0] = this->core.name;
1215 stack [count][1] = XtClass (this)->core_class.class_name;
1220 else if (fake_name && fake_class)
1222 stack [count][0] = fake_name;
1223 stack [count][1] = fake_class;
1227 /* The root widget is an application shell; resource lookups use the
1228 specified application name and application class in preference to
1229 the name/class of that widget (which is argv[0] / "ApplicationShell").
1230 Generally the app name and class will be argv[0] / "Emacs" but
1231 the former can be set via the -name command-line option, and the
1232 latter can be set by changing `x-emacs-application-class' in
1235 XtGetApplicationNameAndClass (display,
1244 for (; count >= 0; count--)
1246 strcat (name_tail, stack [count][0]);
1247 for (; *name_tail; name_tail++)
1248 if (*name_tail == '.') *name_tail = '_';
1249 strcat (name_tail, ".");
1252 strcat (class_tail, stack [count][1]);
1253 for (; *class_tail; class_tail++)
1254 if (*class_tail == '.') *class_tail = '_';
1255 strcat (class_tail, ".");
1262 static char_dynarr *name_char_dynarr;
1263 static char_dynarr *class_char_dynarr;
1265 /* Given a locale and device specification from x-get-resource or
1266 x-get-resource-prefix, return the resource prefix and display to
1267 fetch the resource on. */
1270 x_get_resource_prefix (Lisp_Object locale, Lisp_Object device,
1271 Display **display_out, char_dynarr *name,
1276 if (NILP (Fvalid_specifier_locale_p (locale)))
1277 signal_simple_error ("Invalid locale", locale);
1278 if (WINDOWP (locale))
1279 /* #### I can't come up with any coherent way of naming windows.
1280 By relative position? That seems tricky because windows
1281 can change position, be split, etc. By order of creation?
1282 That seems less than useful. */
1283 signal_simple_error ("Windows currently can't be resourced", locale);
1285 if (!NILP (device) && !DEVICEP (device))
1286 CHECK_DEVICE (device);
1287 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device)))
1291 device = DFW_DEVICE (locale);
1292 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device)))
1295 device = Vdefault_x_device;
1303 *display_out = DEVICE_X_DISPLAY (XDEVICE (device));
1306 char *appname, *appclass;
1307 int name_len, class_len;
1308 XtGetApplicationNameAndClass (*display_out, &appname, &appclass);
1309 name_len = strlen (appname);
1310 class_len = strlen (appclass);
1311 Dynarr_add_many (name , appname, name_len);
1312 Dynarr_add_many (class, appclass, class_len);
1313 validify_resource_component (Dynarr_atp (name, 0), name_len);
1314 validify_resource_component (Dynarr_atp (class, 0), class_len);
1317 if (EQ (locale, Qglobal))
1319 if (BUFFERP (locale))
1321 Dynarr_add_literal_string (name, ".buffer.");
1322 /* we know buffer is live; otherwise we got an error above. */
1323 Dynarr_add_validified_lisp_string (name, Fbuffer_name (locale));
1324 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsBuffer");
1326 else if (FRAMEP (locale))
1328 Dynarr_add_literal_string (name, ".frame.");
1329 /* we know frame is live; otherwise we got an error above. */
1330 Dynarr_add_validified_lisp_string (name, Fframe_name (locale));
1331 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsFrame");
1335 assert (DEVICEP (locale));
1336 Dynarr_add_literal_string (name, ".device.");
1337 /* we know device is live; otherwise we got an error above. */
1338 Dynarr_add_validified_lisp_string (name, Fdevice_name (locale));
1339 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsDevice");
1344 DEFUN ("x-get-resource", Fx_get_resource, 3, 6, 0, /*
1345 Retrieve an X resource from the resource manager.
1347 The first arg is the name of the resource to retrieve, such as "font".
1348 The second arg is the class of the resource to retrieve, such as "Font".
1349 The third arg must be one of the symbols 'string, 'integer, 'natnum, or
1350 'boolean, specifying the type of object that the database is searched for.
1351 The fourth arg is the locale to search for the resources on, and can
1352 currently be a buffer, a frame, a device, or 'global. If omitted, it
1353 defaults to 'global.
1354 The fifth arg is the device to search for the resources on. (The resource
1355 database for a particular device is constructed by combining non-device-
1356 specific resources such as any command-line resources specified and any
1357 app-defaults files found [or the fallback resources supplied by XEmacs,
1358 if no app-defaults file is found] with device-specific resources such as
1359 those supplied using xrdb.) If omitted, it defaults to the device of
1360 LOCALE, if a device can be derived (i.e. if LOCALE is a frame or device),
1361 and otherwise defaults to the value of `default-x-device'.
1362 The sixth arg NOERROR, if non-nil, means do not signal an error if a
1363 bogus resource specification was retrieved (e.g. if a non-integer was
1364 given when an integer was requested). In this case, a warning is issued
1365 instead, unless NOERROR is t, in which case no warning is issued.
1367 The resource names passed to this function are looked up relative to the
1370 If you want to search for a subresource, you just need to specify the
1371 resource levels in NAME and CLASS. For example, NAME could be
1372 "modeline.attributeFont", and CLASS "Face.AttributeFont".
1376 1) If LOCALE is a buffer, a call
1378 (x-get-resource "foreground" "Foreground" 'string SOME-BUFFER)
1380 is an interface to a C call something like
1382 XrmGetResource (db, "xemacs.buffer.BUFFER-NAME.foreground",
1383 "Emacs.EmacsLocaleType.EmacsBuffer.Foreground",
1386 2) If LOCALE is a frame, a call
1388 (x-get-resource "foreground" "Foreground" 'string SOME-FRAME)
1390 is an interface to a C call something like
1392 XrmGetResource (db, "xemacs.frame.FRAME-NAME.foreground",
1393 "Emacs.EmacsLocaleType.EmacsFrame.Foreground",
1396 3) If LOCALE is a device, a call
1398 (x-get-resource "foreground" "Foreground" 'string SOME-DEVICE)
1400 is an interface to a C call something like
1402 XrmGetResource (db, "xemacs.device.DEVICE-NAME.foreground",
1403 "Emacs.EmacsLocaleType.EmacsDevice.Foreground",
1406 4) If LOCALE is 'global, a call
1408 (x-get-resource "foreground" "Foreground" 'string 'global)
1410 is an interface to a C call something like
1412 XrmGetResource (db, "xemacs.foreground",
1416 Note that for 'global, no prefix is added other than that of the
1417 application itself; thus, you can use this locale to retrieve
1418 arbitrary application resources, if you really want to.
1420 The returned value of this function is nil if the queried resource is not
1421 found. If the third arg is `string', a string is returned, and if it is
1422 `integer', an integer is returned. If the third arg is `boolean', then the
1423 returned value is the list (t) for true, (nil) for false, and is nil to
1424 mean ``unspecified''.
1426 (name, class, type, locale, device, no_error))
1428 char* name_string, *class_string;
1432 Error_behavior errb = decode_error_behavior_flag (no_error);
1434 CHECK_STRING (name);
1435 CHECK_STRING (class);
1436 CHECK_SYMBOL (type);
1438 Dynarr_reset (name_char_dynarr);
1439 Dynarr_reset (class_char_dynarr);
1441 x_get_resource_prefix (locale, device, &display,
1442 name_char_dynarr, class_char_dynarr);
1446 db = XtDatabase (display);
1448 Dynarr_add (name_char_dynarr, '.');
1449 Dynarr_add_lisp_string (name_char_dynarr, name);
1450 Dynarr_add (class_char_dynarr, '.');
1451 Dynarr_add_lisp_string (class_char_dynarr, class);
1452 Dynarr_add (name_char_dynarr, '\0');
1453 Dynarr_add (class_char_dynarr, '\0');
1455 name_string = Dynarr_atp (name_char_dynarr, 0);
1456 class_string = Dynarr_atp (class_char_dynarr, 0);
1460 XrmName namelist[100];
1461 XrmClass classlist[100];
1462 XrmName *namerest = namelist;
1463 XrmClass *classrest = classlist;
1464 XrmRepresentation xrm_type;
1465 XrmRepresentation string_quark;
1467 XrmStringToNameList (name_string, namelist);
1468 XrmStringToClassList (class_string, classlist);
1469 string_quark = XrmStringToQuark ("String");
1471 /* ensure that they have the same length */
1472 while (namerest[0] && classrest[0])
1473 namerest++, classrest++;
1474 if (namerest[0] || classrest[0])
1475 signal_simple_error_2
1476 ("class list and name list must be the same length", name, class);
1477 result = XrmQGetResource (db, namelist, classlist, &xrm_type, &xrm_value);
1479 if (result != True || xrm_type != string_quark)
1481 raw_result = (char *) xrm_value.addr;
1484 if (EQ (type, Qstring))
1485 return build_string (raw_result);
1486 else if (EQ (type, Qboolean))
1488 if (!strcasecmp (raw_result, "off") ||
1489 !strcasecmp (raw_result, "false") ||
1490 !strcasecmp (raw_result, "no"))
1491 return Fcons (Qnil, Qnil);
1492 if (!strcasecmp (raw_result, "on") ||
1493 !strcasecmp (raw_result, "true") ||
1494 !strcasecmp (raw_result, "yes"))
1495 return Fcons (Qt, Qnil);
1496 return maybe_continuable_error
1498 "can't convert %s: %s to a Boolean", name_string, raw_result);
1500 else if (EQ (type, Qinteger) || EQ (type, Qnatnum))
1504 if (1 != sscanf (raw_result, "%d%c", &i, &c))
1505 return maybe_continuable_error
1507 "can't convert %s: %s to an integer", name_string, raw_result);
1508 else if (EQ (type, Qnatnum) && i < 0)
1509 return maybe_continuable_error
1511 "invalid numerical value %d for resource %s", i, name_string);
1513 return make_int (i);
1517 return maybe_signal_continuable_error
1518 (Qwrong_type_argument,
1519 list2 (build_translated_string
1520 ("should be string, integer, natnum or boolean"),
1526 DEFUN ("x-get-resource-prefix", Fx_get_resource_prefix, 1, 2, 0, /*
1527 Return the resource prefix for LOCALE on DEVICE.
1528 The resource prefix is the strings used to prefix resources if
1529 the LOCALE and DEVICE arguments were passed to `x-get-resource'.
1530 The returned value is a cons of a name prefix and a class prefix.
1531 For example, if LOCALE is a frame, the returned value might be
1532 \("xemacs.frame.FRAME-NAME" . "Emacs.EmacsLocaleType.EmacsFrame").
1533 If no valid X device for resourcing can be obtained, this function
1534 returns nil. (In such a case, `x-get-resource' would always return nil.)
1540 Dynarr_reset (name_char_dynarr );
1541 Dynarr_reset (class_char_dynarr);
1543 x_get_resource_prefix (locale, device, &display,
1544 name_char_dynarr, class_char_dynarr);
1548 return Fcons (make_string ((Bufbyte *) Dynarr_atp (name_char_dynarr, 0),
1549 Dynarr_length (name_char_dynarr)),
1550 make_string ((Bufbyte *) Dynarr_atp (class_char_dynarr, 0),
1551 Dynarr_length (class_char_dynarr)));
1554 DEFUN ("x-put-resource", Fx_put_resource, 1, 2, 0, /*
1555 Add a resource to the resource database for DEVICE.
1556 RESOURCE-LINE specifies the resource to add and should be a
1557 standard resource specification.
1559 (resource_line, device))
1561 struct device *d = decode_device (device);
1562 char *str, *colon_pos;
1564 CHECK_STRING (resource_line);
1565 str = (char *) XSTRING_DATA (resource_line);
1566 if (!(colon_pos = strchr (str, ':')) || strchr (str, '\n'))
1568 signal_simple_error ("Invalid resource line", resource_line);
1570 /* Only the following chars are allowed before the colon */
1571 " \t.*?abcdefghijklmnopqrstuvwxyz"
1572 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-")
1573 != (size_t) (colon_pos - str))
1578 XrmDatabase db = XtDatabase (DEVICE_X_DISPLAY (d));
1579 XrmPutLineResource (&db, str);
1586 /************************************************************************/
1587 /* display information functions */
1588 /************************************************************************/
1590 DEFUN ("default-x-device", Fdefault_x_device, 0, 0, 0, /*
1591 Return the default X device for resourcing.
1592 This is the first-created X device that still exists.
1596 return Vdefault_x_device;
1599 DEFUN ("x-display-visual-class", Fx_display_visual_class, 0, 1, 0, /*
1600 Return the visual class of the X display DEVICE is using.
1601 This can be altered from the default at startup using the XResource "EmacsVisual".
1602 The returned value will be one of the symbols `static-gray', `gray-scale',
1603 `static-color', `pseudo-color', `true-color', or `direct-color'.
1607 Visual *vis = DEVICE_X_VISUAL (decode_x_device (device));
1610 case StaticGray: return intern ("static-gray");
1611 case GrayScale: return intern ("gray-scale");
1612 case StaticColor: return intern ("static-color");
1613 case PseudoColor: return intern ("pseudo-color");
1614 case TrueColor: return intern ("true-color");
1615 case DirectColor: return intern ("direct-color");
1617 error ("display has an unknown visual class");
1618 return Qnil; /* suppress compiler warning */
1622 DEFUN ("x-display-visual-depth", Fx_display_visual_depth, 0, 1, 0, /*
1623 Return the bitplane depth of the visual the X display DEVICE is using.
1627 return make_int (DEVICE_X_DEPTH (decode_x_device (device)));
1631 x_device_system_metrics (struct device *d,
1632 enum device_metrics m)
1634 Display *dpy = DEVICE_X_DISPLAY (d);
1638 case DM_size_device:
1639 return Fcons (make_int (DisplayWidth (dpy, DefaultScreen (dpy))),
1640 make_int (DisplayHeight (dpy, DefaultScreen (dpy))));
1641 case DM_size_device_mm:
1642 return Fcons (make_int (DisplayWidthMM (dpy, DefaultScreen (dpy))),
1643 make_int (DisplayHeightMM (dpy, DefaultScreen (dpy))));
1644 case DM_num_bit_planes:
1645 return make_int (DisplayPlanes (dpy, DefaultScreen (dpy)));
1646 case DM_num_color_cells:
1647 return make_int (DisplayCells (dpy, DefaultScreen (dpy)));
1648 default: /* No such device metric property for X devices */
1653 DEFUN ("x-server-vendor", Fx_server_vendor, 0, 1, 0, /*
1654 Return the vendor ID string of the X server DEVICE is on.
1655 Return the empty string if the vendor ID string cannot be determined.
1659 Display *dpy = get_x_display (device);
1660 char *vendor = ServerVendor (dpy);
1662 return build_string (vendor ? vendor : "");
1665 DEFUN ("x-server-version", Fx_server_version, 0, 1, 0, /*
1666 Return the version numbers of the X server DEVICE is on.
1667 The returned value is a list of three integers: the major and minor
1668 version numbers of the X Protocol in use, and the vendor-specific release
1669 number. See also `x-server-vendor'.
1673 Display *dpy = get_x_display (device);
1675 return list3 (make_int (ProtocolVersion (dpy)),
1676 make_int (ProtocolRevision (dpy)),
1677 make_int (VendorRelease (dpy)));
1680 DEFUN ("x-valid-keysym-name-p", Fx_valid_keysym_name_p, 1, 1, 0, /*
1681 Return true if KEYSYM names a keysym that the X library knows about.
1682 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1683 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1687 const char *keysym_ext;
1689 CHECK_STRING (keysym);
1690 TO_EXTERNAL_FORMAT (LISP_STRING, keysym,
1691 C_STRING_ALLOCA, keysym_ext,
1694 return XStringToKeysym (keysym_ext) ? Qt : Qnil;
1697 DEFUN ("x-keysym-hash-table", Fx_keysym_hash_table, 0, 1, 0, /*
1698 Return a hash table containing a key for all keysyms on DEVICE.
1699 DEVICE must be an X11 display device. See `x-keysym-on-keyboard-p'.
1703 struct device *d = decode_device (device);
1704 if (!DEVICE_X_P (d))
1705 signal_simple_error ("Not an X device", device);
1707 return DEVICE_X_DATA (d)->x_keysym_map_hash_table;
1710 DEFUN ("x-keysym-on-keyboard-sans-modifiers-p", Fx_keysym_on_keyboard_sans_modifiers_p,
1712 Return true if KEYSYM names a key on the keyboard of DEVICE.
1713 More precisely, return true if pressing a physical key
1714 on the keyboard of DEVICE without any modifier keys generates KEYSYM.
1715 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1716 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1717 The keysym name can be provided in two forms:
1718 - if keysym is a string, it must be the name as known to X windows.
1719 - if keysym is a symbol, it must be the name as known to XEmacs.
1720 The two names differ in capitalization and underscoring.
1724 struct device *d = decode_device (device);
1725 if (!DEVICE_X_P (d))
1726 signal_simple_error ("Not an X device", device);
1728 return (EQ (Qsans_modifiers,
1729 Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ?
1734 DEFUN ("x-keysym-on-keyboard-p", Fx_keysym_on_keyboard_p, 1, 2, 0, /*
1735 Return true if KEYSYM names a key on the keyboard of DEVICE.
1736 More precisely, return true if some keystroke (possibly including modifiers)
1737 on the keyboard of DEVICE keys generates KEYSYM.
1738 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1739 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1740 The keysym name can be provided in two forms:
1741 - if keysym is a string, it must be the name as known to X windows.
1742 - if keysym is a symbol, it must be the name as known to XEmacs.
1743 The two names differ in capitalization and underscoring.
1747 struct device *d = decode_device (device);
1748 if (!DEVICE_X_P (d))
1749 signal_simple_error ("Not an X device", device);
1751 return (NILP (Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ?
1756 /************************************************************************/
1757 /* grabs and ungrabs */
1758 /************************************************************************/
1760 DEFUN ("x-grab-pointer", Fx_grab_pointer, 0, 3, 0, /*
1761 Grab the pointer and restrict it to its current window.
1762 If optional DEVICE argument is nil, the default device will be used.
1763 If optional CURSOR argument is non-nil, change the pointer shape to that
1764 until `x-ungrab-pointer' is called (it should be an object returned by the
1765 `make-cursor-glyph' function).
1766 If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all
1767 keyboard events during the grab.
1768 Returns t if the grab is successful, nil otherwise.
1770 (device, cursor, ignore_keyboard))
1773 int pointer_mode, result;
1774 struct device *d = decode_x_device (device);
1778 CHECK_POINTER_GLYPH (cursor);
1779 cursor = glyph_image_instance (cursor, device, ERROR_ME, 0);
1782 if (!NILP (ignore_keyboard))
1783 pointer_mode = GrabModeSync;
1785 pointer_mode = GrabModeAsync;
1787 w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d)));
1789 /* #### Possibly this needs to gcpro the cursor somehow, but it doesn't
1790 seem to cause a problem if XFreeCursor is called on a cursor in use
1791 in a grab; I suppose the X server counts the grab as a reference
1792 and doesn't free it until it exits? */
1793 result = XGrabPointer (DEVICE_X_DISPLAY (d), w,
1798 PointerMotionHintMask,
1799 GrabModeAsync, /* Keep pointer events flowing */
1800 pointer_mode, /* Stall keyboard events */
1801 w, /* Stay in this window */
1803 : XIMAGE_INSTANCE_X_CURSOR (cursor)),
1805 return (result == GrabSuccess) ? Qt : Qnil;
1808 DEFUN ("x-ungrab-pointer", Fx_ungrab_pointer, 0, 1, 0, /*
1809 Release a pointer grab made with `x-grab-pointer'.
1810 If optional first arg DEVICE is nil the default device is used.
1811 If it is t the pointer will be released on all X devices.
1815 if (!EQ (device, Qt))
1817 Display *dpy = get_x_display (device);
1818 XUngrabPointer (dpy, CurrentTime);
1822 Lisp_Object devcons, concons;
1824 DEVICE_LOOP_NO_BREAK (devcons, concons)
1826 struct device *d = XDEVICE (XCAR (devcons));
1829 XUngrabPointer (DEVICE_X_DISPLAY (d), CurrentTime);
1836 DEFUN ("x-grab-keyboard", Fx_grab_keyboard, 0, 1, 0, /*
1837 Grab the keyboard on the given device (defaulting to the selected one).
1838 So long as the keyboard is grabbed, all keyboard events will be delivered
1839 to emacs -- it is not possible for other X clients to eavesdrop on them.
1840 Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect).
1841 Returns t if the grab is successful, nil otherwise.
1845 struct device *d = decode_x_device (device);
1846 Window w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d)));
1847 Display *dpy = DEVICE_X_DISPLAY (d);
1850 status = XGrabKeyboard (dpy, w, True,
1851 /* I don't really understand sync-vs-async
1852 grabs, but this is what xterm does. */
1853 GrabModeAsync, GrabModeAsync,
1854 /* Use the timestamp of the last user action
1855 read by emacs proper; xterm uses CurrentTime
1856 but there's a comment that says "wrong"...
1857 (Despite the name this is the time of the
1858 last key or mouse event.) */
1859 DEVICE_X_MOUSE_TIMESTAMP (d));
1860 if (status == GrabSuccess)
1862 /* The XUngrabKeyboard should generate a FocusIn back to this
1863 window but it doesn't unless we explicitly set focus to the
1864 window first (which should already have it. The net result
1865 is that without this call when x-ungrab-keyboard is called
1866 the selected frame ends up not having focus. */
1867 XSetInputFocus (dpy, w, RevertToParent, DEVICE_X_MOUSE_TIMESTAMP (d));
1874 DEFUN ("x-ungrab-keyboard", Fx_ungrab_keyboard, 0, 1, 0, /*
1875 Release a keyboard grab made with `x-grab-keyboard'.
1879 Display *dpy = get_x_display (device);
1880 XUngrabKeyboard (dpy, CurrentTime);
1884 DEFUN ("x-get-font-path", Fx_get_font_path, 0, 1, 0, /*
1885 Get the X Server's font path.
1887 See also `x-set-font-path'.
1891 Display *dpy = get_x_display (device);
1893 const char **directories = (const char **) XGetFontPath (dpy, &ndirs_return);
1894 Lisp_Object font_path = Qnil;
1897 signal_simple_error ("Can't get X font path", device);
1899 while (ndirs_return--)
1900 font_path = Fcons (build_ext_string (directories[ndirs_return],
1907 DEFUN ("x-set-font-path", Fx_set_font_path, 1, 2, 0, /*
1908 Set the X Server's font path to FONT-PATH.
1910 There is only one font path per server, not one per client. Use this
1911 sparingly. It uncaches all of the X server's font information.
1913 Font directories should end in the path separator and should contain
1914 a file called fonts.dir usually created with the program mkfontdir.
1916 Setting the FONT-PATH to nil tells the X server to use the default
1919 See also `x-get-font-path'.
1921 (font_path, device))
1923 Display *dpy = get_x_display (device);
1924 Lisp_Object path_entry;
1925 const char **directories;
1928 EXTERNAL_LIST_LOOP (path_entry, font_path)
1930 CHECK_STRING (XCAR (path_entry));
1934 directories = alloca_array (const char *, ndirs);
1936 EXTERNAL_LIST_LOOP (path_entry, font_path)
1938 TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (path_entry),
1939 C_STRING_ALLOCA, directories[i++],
1943 expect_x_error (dpy);
1944 XSetFontPath (dpy, (char **) directories, ndirs);
1945 signal_if_x_error (dpy, 1/*resumable_p*/);
1951 /************************************************************************/
1952 /* initialization */
1953 /************************************************************************/
1956 syms_of_device_x (void)
1958 DEFSUBR (Fx_debug_mode);
1959 DEFSUBR (Fx_get_resource);
1960 DEFSUBR (Fx_get_resource_prefix);
1961 DEFSUBR (Fx_put_resource);
1963 DEFSUBR (Fdefault_x_device);
1964 DEFSUBR (Fx_display_visual_class);
1965 DEFSUBR (Fx_display_visual_depth);
1966 DEFSUBR (Fx_server_vendor);
1967 DEFSUBR (Fx_server_version);
1968 DEFSUBR (Fx_valid_keysym_name_p);
1969 DEFSUBR (Fx_keysym_hash_table);
1970 DEFSUBR (Fx_keysym_on_keyboard_p);
1971 DEFSUBR (Fx_keysym_on_keyboard_sans_modifiers_p);
1973 DEFSUBR (Fx_grab_pointer);
1974 DEFSUBR (Fx_ungrab_pointer);
1975 DEFSUBR (Fx_grab_keyboard);
1976 DEFSUBR (Fx_ungrab_keyboard);
1978 DEFSUBR (Fx_get_font_path);
1979 DEFSUBR (Fx_set_font_path);
1981 defsymbol (&Qx_error, "x-error");
1982 defsymbol (&Qinit_pre_x_win, "init-pre-x-win");
1983 defsymbol (&Qinit_post_x_win, "init-post-x-win");
1987 reinit_console_type_create_device_x (void)
1989 /* Initialize variables to speed up X resource interactions */
1990 const char *valid_resource_chars =
1991 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_";
1992 while (*valid_resource_chars)
1993 valid_resource_char_p[(unsigned int) (*valid_resource_chars++)] = 1;
1995 name_char_dynarr = Dynarr_new (char);
1996 class_char_dynarr = Dynarr_new (char);
2000 console_type_create_device_x (void)
2002 reinit_console_type_create_device_x ();
2003 CONSOLE_HAS_METHOD (x, init_device);
2004 CONSOLE_HAS_METHOD (x, finish_init_device);
2005 CONSOLE_HAS_METHOD (x, mark_device);
2006 CONSOLE_HAS_METHOD (x, delete_device);
2007 CONSOLE_HAS_METHOD (x, device_system_metrics);
2011 reinit_vars_of_device_x (void)
2016 in_resource_setting = 0;
2020 vars_of_device_x (void)
2022 reinit_vars_of_device_x ();
2024 DEFVAR_LISP ("x-emacs-application-class", &Vx_emacs_application_class /*
2025 The X application class of the XEmacs process.
2026 This controls, among other things, the name of the `app-defaults' file
2027 that XEmacs will use. For changes to this variable to take effect, they
2028 must be made before the connection to the X server is initialized, that is,
2029 this variable may only be changed before emacs is dumped, or by setting it
2030 in the file lisp/term/x-win.el.
2032 If this variable is nil before the connection to the X server is first
2033 initialized (which it is by default), the X resource database will be
2034 consulted and the value will be set according to whether any resources
2035 are found for the application class `XEmacs'. If the user has set any
2036 resources for the XEmacs application class, the XEmacs process will use
2037 the application class `XEmacs'. Otherwise, the XEmacs process will use
2038 the application class `Emacs' which is backwards compatible to previous
2039 XEmacs versions but may conflict with resources intended for GNU Emacs.
2041 Vx_emacs_application_class = Qnil;
2043 DEFVAR_LISP ("x-initial-argv-list", &Vx_initial_argv_list /*
2044 You don't want to know.
2045 This is used during startup to communicate the remaining arguments in
2046 `command-line-args-left' to the C code, which passes the args to
2047 the X initialization code, which removes some args, and then the
2048 args are placed back into `x-initial-arg-list' and thence into
2049 `command-line-args-left'. Perhaps `command-line-args-left' should
2052 Vx_initial_argv_list = Qnil;
2054 #if defined(MULE) && (defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET))
2055 DEFVAR_LISP ("x-app-defaults-directory", &Vx_app_defaults_directory /*
2056 Used by the Lisp code to communicate to the low level X initialization
2057 where the localized init files are.
2059 Vx_app_defaults_directory = Qnil;
2064 staticpro (&Vdefault_x_device);
2065 Vdefault_x_device = Qnil;