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 /************************************************************************/
172 allocate_x_device_struct (struct device *d)
174 d->device_data = xnew_and_zero (struct x_device);
178 Xatoms_of_device_x (struct device *d)
180 Display *D = DEVICE_X_DISPLAY (d);
182 DEVICE_XATOM_WM_PROTOCOLS (d) = XInternAtom (D, "WM_PROTOCOLS", False);
183 DEVICE_XATOM_WM_DELETE_WINDOW(d) = XInternAtom (D, "WM_DELETE_WINDOW",False);
184 DEVICE_XATOM_WM_SAVE_YOURSELF(d) = XInternAtom (D, "WM_SAVE_YOURSELF",False);
185 DEVICE_XATOM_WM_TAKE_FOCUS (d) = XInternAtom (D, "WM_TAKE_FOCUS", False);
186 DEVICE_XATOM_WM_STATE (d) = XInternAtom (D, "WM_STATE", False);
190 sanity_check_geometry_resource (Display *dpy)
192 char *app_name, *app_class, *s;
193 char buf1 [255], buf2 [255];
196 XtGetApplicationNameAndClass (dpy, &app_name, &app_class);
197 strcpy (buf1, app_name);
198 strcpy (buf2, app_class);
199 for (s = buf1; *s; s++) if (*s == '.') *s = '_';
200 strcat (buf1, "._no_._such_._resource_.geometry");
201 strcat (buf2, "._no_._such_._resource_.Geometry");
202 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)
204 warn_when_safe (Qgeometry, Qerror,
206 "Apparently \"%s*geometry: %s\" or \"%s*geometry: %s\" was\n"
207 "specified in the resource database. Specifying \"*geometry\" will make\n"
208 "XEmacs (and most other X programs) malfunction in obscure ways. (i.e.\n"
209 "the Xt or Xm libraries will probably crash, which is a very bad thing.)\n"
210 "You should always use \".geometry\" or \"*EmacsFrame.geometry\" instead.\n",
211 app_name, (char *) value.addr,
212 app_class, (char *) value.addr);
213 suppress_early_error_handler_backtrace = 1;
214 error ("Invalid geometry resource");
219 x_init_device_class (struct device *d)
221 if (DEVICE_X_DEPTH(d) > 2)
223 switch (DEVICE_X_VISUAL(d)->class)
227 DEVICE_CLASS (d) = Qgrayscale;
230 DEVICE_CLASS (d) = Qcolor;
234 DEVICE_CLASS (d) = Qmono;
238 * Figure out what application name to use for xemacs
240 * Since we have decomposed XtOpenDisplay into XOpenDisplay and
241 * XtDisplayInitialize, we no longer get this for free.
243 * If there is a `-name' argument in argv, use that.
244 * Otherwise use the last component of argv[0].
246 * I have removed the gratuitous use of getenv("RESOURCE_NAME")
247 * which was in X11R5, but left the matching of any prefix of `-name'.
248 * Finally, if all else fails, return `xemacs', as it is more
249 * appropriate (X11R5 returns `main').
252 compute_x_app_name (int argc, Extbyte **argv)
257 for (i = 1; i < argc - 1; i++)
258 if (!strncmp(argv[i], "-name", max (2, strlen (argv[1]))))
261 if (argc > 0 && argv[0] && *argv[0])
262 return (ptr = strrchr (argv[0], '/')) ? ++ptr : argv[0];
268 * This function figures out whether the user has any resources of the
269 * form "XEmacs.foo" or "XEmacs*foo".
271 * Currently we only consult the display's global resources; to look
272 * for screen specific resources, we would need to also consult:
273 * xdefs = XScreenResourceString(ScreenOfDisplay(dpy, scrno));
276 have_xemacs_resources_in_xrdb (Display *dpy)
291 xdefs = XResourceManagerString (dpy); /* don't free - owned by X */
292 while (xdefs && *xdefs)
294 if (strncmp (xdefs, key, len) == 0 &&
295 (xdefs[len] == '*' || xdefs[len] == '.'))
298 while (*xdefs && *xdefs++ != '\n') /* find start of next entry.. */
305 /* Only the characters [-_A-Za-z0-9] are allowed in the individual
306 components of a resource. Convert invalid characters to `-' */
308 static char valid_resource_char_p[256];
311 validify_resource_component (char *str, size_t len)
313 for (; len; len--, str++)
314 if (!valid_resource_char_p[(unsigned char) (*str)])
319 Dynarr_add_validified_lisp_string (char_dynarr *cda, Lisp_Object str)
321 Bytecount len = XSTRING_LENGTH (str);
322 Dynarr_add_many (cda, (char *) XSTRING_DATA (str), len);
323 validify_resource_component (Dynarr_atp (cda, Dynarr_length (cda) - len), len);
327 /* compare visual info for qsorting */
329 x_comp_visual_info (const void *elem1, const void *elem2)
331 XVisualInfo *left, *right;
333 left = (XVisualInfo *)elem1;
334 right = (XVisualInfo *)elem2;
341 if ( left->depth > right->depth ) {
344 else if ( left->depth == right->depth ) {
345 if ( left->colormap_size > right->colormap_size )
347 if ( left->class > right->class )
349 else if ( left->class < right->class )
361 #define XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN
363 x_try_best_visual_class (Screen *screen, int scrnum, int visual_class)
365 Display *dpy = DisplayOfScreen (screen);
367 XVisualInfo *vi_out = NULL;
370 vi_in.class = visual_class;
371 vi_in.screen = scrnum;
372 vi_out = XGetVisualInfo (dpy, (VisualClassMask | VisualScreenMask),
378 for (i = 0, best = 0; i < out_count; i++)
379 /* It's better if it's deeper, or if it's the same depth with
380 more cells (does that ever happen? Well, it could...)
381 NOTE: don't allow pseudo color to get larger than 8! */
382 if (((vi_out [i].depth > vi_out [best].depth) ||
383 ((vi_out [i].depth == vi_out [best].depth) &&
384 (vi_out [i].colormap_size > vi_out [best].colormap_size)))
385 #ifdef XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN
386 /* For now, the image library doesn't like PseudoColor visuals
387 of depths other than 1 or 8. Depths greater than 8 only occur
388 on machines which have TrueColor anyway, so probably we'll end
389 up using that (it is the one that `Best' would pick) but if a
390 PseudoColor visual is explicitly specified, pick the 8 bit one.
392 && (visual_class != PseudoColor ||
393 vi_out [i].depth == 1 ||
394 vi_out [i].depth == 8)
397 /* SGI has 30-bit deep visuals. Ignore them.
398 (We only have 24-bit data anyway.)
400 && (vi_out [i].depth <= 24)
403 visual = vi_out[best].visual;
404 XFree ((char *) vi_out);
412 x_get_visual_depth (Display *dpy, Visual *visual)
418 vi_in.visualid = XVisualIDFromVisual (visual);
419 vi_out = XGetVisualInfo (dpy, /*VisualScreenMask|*/VisualIDMask,
421 if (! vi_out) abort ();
422 d = vi_out [0].depth;
423 XFree ((char *) vi_out);
428 x_try_best_visual (Display *dpy, int scrnum)
430 Visual *visual = NULL;
431 Screen *screen = ScreenOfDisplay (dpy, scrnum);
432 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor))
433 && x_get_visual_depth (dpy, visual) >= 16 )
435 if ((visual = x_try_best_visual_class (screen, scrnum, PseudoColor)))
437 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor)))
439 #ifdef DIRECTCOLOR_WORKS
440 if ((visual = x_try_best_visual_class (screen, scrnum, DirectColor)))
444 visual = DefaultVisualOfScreen (screen);
445 if ( x_get_visual_depth (dpy, visual) >= 8 )
448 if ((visual = x_try_best_visual_class (screen, scrnum, StaticGray)))
450 if ((visual = x_try_best_visual_class (screen, scrnum, GrayScale)))
452 return DefaultVisualOfScreen (screen);
457 x_init_device (struct device *d, Lisp_Object props)
465 const char *app_class;
466 const char *app_name;
467 const char *disp_name;
468 Visual *visual = NULL;
469 int depth = 8; /* shut up the compiler */
473 int best_visual_found = 0;
475 #if defined(HAVE_SHLIB) && defined(LWLIB_USES_ATHENA) && !defined(HAVE_ATHENA_3D)
477 * In order to avoid the lossage with flat Athena widgets dynamically
478 * linking to one of the ThreeD variants, using the dynamic symbol helpers
479 * to look for symbols that shouldn't be there and refusing to run if they
480 * are seems a less toxic idea than having XEmacs crash when we try and
481 * use a subclass of a widget that has changed size.
483 * It's ugly, I know, and not going to work everywhere. It seems better to
484 * do our damnedest to try and tell the user what to expect rather than
485 * simply blow up though.
487 * All the ThreeD variants I have access to define the following function
488 * symbols in the shared library. The flat Xaw library does not define them:
490 * Xaw3dComputeBottomShadowRGB
491 * Xaw3dComputeTopShadowRGB
493 * So far only Linux has shown this problem. This seems to be portable to
494 * all the distributions (certainly all the ones I checked - Debian and
497 * This will only work, sadly, with dlopen() -- the other dynamic linkers
498 * are simply not capable of doing what is needed. :/
502 /* Get a dll handle to the main process. */
503 dll_handle xaw_dll_handle = dll_open (NULL);
505 /* Did that fail? If so, continue without error.
506 * We could die here but, well, that's unfriendly and all -- plus I feel
507 * better about some crashing somewhere rather than preventing a perfectly
508 * good configuration working just because dll_open failed.
510 if (xaw_dll_handle != NULL)
512 /* Look for the Xaw3d function */
513 dll_func xaw_function_handle =
514 dll_function (xaw_dll_handle, "Xaw3dComputeTopShadowRGB");
516 /* If we found it, warn the user in big, nasty, unfriendly letters */
517 if (xaw_function_handle != NULL)
519 warn_when_safe (Qdevice, Qerror, "\n"
520 "It seems that XEmacs is built dynamically linked to the flat Athena widget\n"
521 "library but it finds a 3D Athena variant with the same name at runtime.\n"
523 "This WILL cause your XEmacs process to dump core at some point.\n"
524 "You should not continue to use this binary without resolving this issue.\n"
526 "This can be solved with the xaw-wrappers package under Debian\n"
527 "(register XEmacs as incompatible with all 3d widget sets, see\n"
528 "update-xaw-wrappers(8) and .../doc/xaw-wrappers/README.packagers). It\n"
529 "can be verified by checking the runtime path in /etc/ld.so.conf and by\n"
530 "using `ldd /path/to/xemacs' under other Linux distributions. One\n"
531 "solution is to use LD_PRELOAD or LD_LIBRARY_PATH to force ld.so to\n"
532 "load the flat Athena widget library instead of the aliased 3D widget\n"
533 "library (see ld.so(8) for use of these environment variables).\n\n"
538 /* Otherwise release the handle to the library
539 * No error catch here; I can't think of a way to recover anyhow.
541 dll_close (xaw_dll_handle);
544 #endif /* HAVE_SHLIB and LWLIB_USES_ATHENA and not HAVE_ATHENA_3D */
547 XSETDEVICE (device, d);
548 display = DEVICE_CONNECTION (d);
550 allocate_x_device_struct (d);
552 make_argc_argv (Vx_initial_argv_list, &argc, &argv);
554 LISP_STRING_TO_EXTERNAL (display, disp_name, Qctext);
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 LISP_STRING_TO_EXTERNAL (Vx_emacs_application_class, app_class, Qctext);
579 app_class = (NILP (Vx_emacs_application_class) &&
580 have_xemacs_resources_in_xrdb (dpy))
587 /* need to update Vx_emacs_application_class: */
588 Vx_emacs_application_class = build_string (app_class);
591 slow_down_interrupts ();
592 /* May not be needed but XtOpenDisplay could not deal with signals here.
594 XtDisplayInitialize (Xt_app_con, dpy, compute_x_app_name (argc, argv),
595 app_class, emacs_options,
596 XtNumber (emacs_options), &argc, (char **) argv);
597 speed_up_interrupts ();
599 screen = DefaultScreen (dpy);
600 if (NILP (Vdefault_x_device))
601 Vdefault_x_device = device;
604 #if defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET)
606 /* Read in locale-specific resources from
607 data-directory/app-defaults/$LANG/Emacs.
608 This is in addition to the standard app-defaults files, and
609 does not override resources defined elsewhere */
610 const char *data_dir;
612 XrmDatabase db = XtDatabase (dpy); /* #### XtScreenDatabase(dpy) ? */
613 const char *locale = XrmLocaleOfDatabase (db);
615 if (STRINGP (Vx_app_defaults_directory) &&
616 XSTRING_LENGTH (Vx_app_defaults_directory) > 0)
618 LISP_STRING_TO_EXTERNAL (Vx_app_defaults_directory, data_dir, Qfile_name);
619 path = (char *)alloca (strlen (data_dir) + strlen (locale) + 7);
620 sprintf (path, "%s%s/Emacs", data_dir, locale);
621 if (!access (path, R_OK))
622 XrmCombineFileDatabase (path, &db, False);
624 else if (STRINGP (Vdata_directory) && XSTRING_LENGTH (Vdata_directory) > 0)
626 LISP_STRING_TO_EXTERNAL (Vdata_directory, data_dir, Qfile_name);
627 path = (char *)alloca (strlen (data_dir) + 13 + strlen (locale) + 7);
628 sprintf (path, "%sapp-defaults/%s/Emacs", data_dir, locale);
629 if (!access (path, R_OK))
630 XrmCombineFileDatabase (path, &db, False);
633 #endif /* LWLIB_MENUBARS_MOTIF or HAVE_XIM USE_XFONTSET */
636 if (NILP (DEVICE_NAME (d)))
637 DEVICE_NAME (d) = display;
639 /* We're going to modify the string in-place, so be a nice XEmacs */
640 DEVICE_NAME (d) = Fcopy_sequence (DEVICE_NAME (d));
641 /* colons and periods can't appear in individual elements of resource
644 XtGetApplicationNameAndClass (dpy, (char **) &app_name, (char **) &app_class);
645 /* search for a matching visual if requested by the user, or setup the display default */
647 int resource_name_length = max (sizeof (".emacsVisual"),
648 sizeof (".privateColormap"));
649 char *buf1 = alloca_array (char, strlen (app_name) + resource_name_length);
650 char *buf2 = alloca_array (char, strlen (app_class) + resource_name_length);
654 sprintf (buf1, "%s.emacsVisual", app_name);
655 sprintf (buf2, "%s.EmacsVisual", app_class);
656 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)
659 int vis_class = PseudoColor;
661 char *str = (char*) value.addr;
663 #define CHECK_VIS_CLASS(visual_class) \
664 else if (memcmp (str, #visual_class, sizeof (#visual_class) - 1) == 0) \
665 cnt = sizeof (#visual_class) - 1, vis_class = visual_class
669 CHECK_VIS_CLASS (StaticGray);
670 CHECK_VIS_CLASS (StaticColor);
671 CHECK_VIS_CLASS (TrueColor);
672 CHECK_VIS_CLASS (GrayScale);
673 CHECK_VIS_CLASS (PseudoColor);
674 CHECK_VIS_CLASS (DirectColor);
678 depth = atoi (str + cnt);
681 stderr_out ("Invalid Depth specification in %s... ignoring...\n", str);
685 if (XMatchVisualInfo (dpy, screen, depth, vis_class, &vinfo))
687 visual = vinfo.visual;
691 stderr_out ("Can't match the requested visual %s... using defaults\n", str);
697 stderr_out( "Invalid Visual specification in %s... ignoring.\n", str);
703 visual = DefaultVisual(dpy, screen);
704 depth = DefaultDepth(dpy, screen);
706 visual = x_try_best_visual (dpy, screen);
707 depth = x_get_visual_depth (dpy, visual);
708 best_visual_found = (visual != DefaultVisual (dpy, screen));
711 /* If we've got the same visual as the default and it's PseudoColor,
712 check to see if the user specified that we need a private colormap */
713 if (visual == DefaultVisual (dpy, screen))
715 sprintf (buf1, "%s.privateColormap", app_name);
716 sprintf (buf2, "%s.PrivateColormap", app_class);
717 if ((visual->class == PseudoColor) &&
718 (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True))
720 cmap = XCopyColormapAndFree (dpy, DefaultColormap (dpy, screen));
724 cmap = DefaultColormap (dpy, screen);
729 if ( best_visual_found )
731 cmap = XCreateColormap (dpy, RootWindow (dpy, screen), visual, AllocNone);
735 /* We have to create a matching colormap anyway...
736 #### think about using standard colormaps (need the Xmu libs?) */
737 cmap = XCreateColormap(dpy, RootWindow(dpy, screen), visual, AllocNone);
738 XInstallColormap(dpy, cmap);
743 DEVICE_X_VISUAL (d) = visual;
744 DEVICE_X_COLORMAP (d) = cmap;
745 DEVICE_X_DEPTH (d) = depth;
746 validify_resource_component ((char *) XSTRING_DATA (DEVICE_NAME (d)),
747 XSTRING_LENGTH (DEVICE_NAME (d)));
751 XtSetArg (al[0], XtNvisual, visual);
752 XtSetArg (al[1], XtNdepth, depth);
753 XtSetArg (al[2], XtNcolormap, cmap);
755 app_shell = XtAppCreateShell (NULL, app_class,
756 applicationShellWidgetClass,
757 dpy, al, countof (al));
760 DEVICE_XT_APP_SHELL (d) = app_shell;
764 #endif /* HAVE_XIM */
766 /* Realize the app_shell so that its window exists for GC creation purposes,
767 and set it to the size of the root window for child placement purposes */
770 XtSetArg (al[0], XtNmappedWhenManaged, False);
771 XtSetArg (al[1], XtNx, 0);
772 XtSetArg (al[2], XtNy, 0);
773 XtSetArg (al[3], XtNwidth, WidthOfScreen (ScreenOfDisplay (dpy, screen)));
774 XtSetArg (al[4], XtNheight, HeightOfScreen (ScreenOfDisplay (dpy, screen)));
775 XtSetValues (app_shell, al, countof (al));
776 XtRealizeWidget (app_shell);
779 #ifdef HAVE_WMCOMMAND
783 make_argc_argv (Vcommand_line_args, &new_argc, &new_argv);
784 XSetCommand (XtDisplay (app_shell), XtWindow (app_shell),
785 (char **) new_argv, new_argc);
786 free_argc_argv (new_argv);
788 #endif /* HAVE_WMCOMMAND */
791 #ifdef HAVE_OFFIX_DND
792 DndInitialize ( app_shell );
795 Vx_initial_argv_list = make_arg_list (argc, argv);
796 free_argc_argv (argv);
798 DEVICE_X_WM_COMMAND_FRAME (d) = Qnil;
800 sanity_check_geometry_resource (dpy);
803 x_init_modifier_mapping (d);
805 DEVICE_INFD (d) = DEVICE_OUTFD (d) = ConnectionNumber (dpy);
809 DEVICE_X_GC_CACHE (d) = make_gc_cache (dpy, XtWindow(app_shell));
810 DEVICE_X_GRAY_PIXMAP (d) = None;
811 Xatoms_of_device_x (d);
812 Xatoms_of_select_x (d);
813 Xatoms_of_objects_x (d);
814 x_init_device_class (d);
816 /* Run the elisp side of the X device initialization. */
817 call0 (Qinit_pre_x_win);
821 x_finish_init_device (struct device *d, Lisp_Object props)
823 call0 (Qinit_post_x_win);
827 x_mark_device (struct device *d)
829 mark_object (DEVICE_X_WM_COMMAND_FRAME (d));
830 mark_object (DEVICE_X_DATA (d)->x_keysym_map_hash_table);
834 /************************************************************************/
835 /* closing an X connection */
836 /************************************************************************/
839 free_x_device_struct (struct device *d)
841 xfree (d->device_data);
845 x_delete_device (struct device *d)
850 extern void (*__free_hook) (void *);
854 XSETDEVICE (device, d);
855 display = DEVICE_X_DISPLAY (d);
860 checking_free = (__free_hook != 0);
862 /* Disable strict free checking, to avoid bug in X library */
864 disable_strict_free_check ();
867 free_gc_cache (DEVICE_X_GC_CACHE (d));
868 if (DEVICE_X_DATA (d)->x_modifier_keymap)
869 XFreeModifiermap (DEVICE_X_DATA (d)->x_modifier_keymap);
870 if (DEVICE_X_DATA (d)->x_keysym_map)
871 XFree ((char *) DEVICE_X_DATA (d)->x_keysym_map);
873 if (DEVICE_XT_APP_SHELL (d))
875 XtDestroyWidget (DEVICE_XT_APP_SHELL (d));
876 DEVICE_XT_APP_SHELL (d) = NULL;
879 XtCloseDisplay (display);
880 DEVICE_X_DISPLAY (d) = 0;
883 enable_strict_free_check ();
887 if (EQ (device, Vdefault_x_device))
889 Lisp_Object devcons, concons;
890 /* #### handle deleting last X device */
891 Vdefault_x_device = Qnil;
892 DEVICE_LOOP_NO_BREAK (devcons, concons)
894 if (DEVICE_X_P (XDEVICE (XCAR (devcons))) &&
895 !EQ (device, XCAR (devcons)))
897 Vdefault_x_device = XCAR (devcons);
903 free_x_device_struct (d);
907 /************************************************************************/
908 /* handle X errors */
909 /************************************************************************/
912 x_event_name (int event_type)
914 static const char *events[] =
954 if (event_type < 0 || event_type >= countof (events))
956 return events [event_type];
961 If an X error occurs which we are not expecting, we have no alternative
962 but to print it to stderr. It would be nice to stuff it into a pop-up
963 buffer, or to print it in the minibuffer, but that's not possible, because
964 one is not allowed to do any I/O on the display connection from an error
965 handler. The guts of Xlib expect these functions to either return or exit.
967 However, there are occasions when we might expect an error to reasonably
968 occur. The interface to this is as follows:
970 Before calling some X routine which may error, call
971 expect_x_error (dpy);
973 Just after calling the X routine, call either:
975 x_error_occurred_p (dpy);
977 to ask whether an error happened (and was ignored), or:
979 signal_if_x_error (dpy, resumable_p);
981 which will call Fsignal() with args appropriate to the X error, if there
982 was one. (Resumable_p is whether the debugger should be allowed to
983 continue from the call to signal.)
985 You must call one of these two routines immediately after calling the X
986 routine; think of them as bookends like BLOCK_INPUT and UNBLOCK_INPUT.
989 static int error_expected;
990 static int error_occurred;
991 static XErrorEvent last_error;
995 #ifdef EXTERNAL_WIDGET
997 x_error_handler_do_enqueue (Lisp_Object frame)
999 enqueue_magic_eval_event (io_error_delete_frame, frame);
1004 x_error_handler_error (Lisp_Object data, Lisp_Object dummy)
1008 #endif /* EXTERNAL_WIDGET */
1011 x_error_handler (Display *disp, XErrorEvent *event)
1017 last_error = *event;
1021 #ifdef EXTERNAL_WIDGET
1023 struct device *d = get_device_from_display (disp);
1025 if ((event->error_code == BadWindow ||
1026 event->error_code == BadDrawable)
1027 && ((f = x_any_window_to_frame (d, event->resourceid)) != 0))
1031 /* one of the windows comprising one of our frames has died.
1032 This occurs particularly with ExternalShell frames when the
1033 client that owns the ExternalShell's window dies.
1035 We cannot do any I/O on the display connection so we need
1036 to enqueue an eval event so that the deletion happens
1039 Furthermore, we need to trap any errors (out-of-memory) that
1040 may occur when Fenqueue_eval_event is called.
1043 if (f->being_deleted)
1045 XSETFRAME (frame, f);
1046 if (!NILP (condition_case_1 (Qerror, x_error_handler_do_enqueue,
1047 frame, x_error_handler_error, Qnil)))
1049 f->being_deleted = 1;
1054 #endif /* EXTERNAL_WIDGET */
1056 stderr_out ("\n%s: ",
1057 (STRINGP (Vinvocation_name)
1058 ? (char *) XSTRING_DATA (Vinvocation_name)
1060 XmuPrintDefaultErrorMessage (disp, event, stderr);
1066 expect_x_error (Display *dpy)
1068 assert (!error_expected);
1069 XSync (dpy, 0); /* handle pending errors before setting flag */
1075 x_error_occurred_p (Display *dpy)
1078 XSync (dpy, 0); /* handle pending errors before setting flag */
1079 val = error_occurred;
1086 signal_if_x_error (Display *dpy, int resumable_p)
1090 if (! x_error_occurred_p (dpy))
1093 sprintf (buf, "0x%X", (unsigned int) last_error.resourceid);
1094 data = Fcons (build_string (buf), data);
1097 sprintf (num, "%d", last_error.request_code);
1098 XGetErrorDatabaseText (last_error.display, "XRequest", num, "",
1101 sprintf (buf, "Request-%d", last_error.request_code);
1102 data = Fcons (build_string (buf), data);
1104 XGetErrorText (last_error.display, last_error.error_code, buf, sizeof (buf));
1105 data = Fcons (build_string (buf), data);
1107 Fsignal (Qx_error, data);
1108 if (! resumable_p) goto again;
1113 x_IO_error_handler (Display *disp)
1115 /* This function can GC */
1117 struct device *d = get_device_from_display_1 (disp);
1120 XSETDEVICE (dev, d);
1122 if (NILP (find_nonminibuffer_frame_not_on_device (dev)))
1124 /* We're going down. */
1126 ("\n%s: Fatal I/O Error %d (%s) on display connection \"%s\"\n",
1127 (STRINGP (Vinvocation_name) ?
1128 (char *) XSTRING_DATA (Vinvocation_name) : "xemacs"),
1129 errno, strerror (errno), DisplayString (disp));
1131 (" after %lu requests (%lu known processed) with %d events remaining.\n",
1132 NextRequest (disp) - 1, LastKnownRequestProcessed (disp),
1134 /* assert (!_Xdebug); */
1140 "I/O Error %d (%s) on display connection\n"
1141 " \"%s\" after after %lu requests (%lu known processed)\n"
1142 " with %d events remaining.\n"
1143 " Throwing to top level.\n",
1144 errno, strerror (errno), DisplayString (disp),
1145 NextRequest (disp) - 1, LastKnownRequestProcessed (disp),
1149 /* According to X specs, we should not return from this function, or
1150 Xlib might just decide to exit(). So we mark the offending
1151 console for deletion and throw to top level. */
1153 enqueue_magic_eval_event (io_error_delete_device, dev);
1154 DEVICE_X_BEING_DELETED (d) = 1;
1155 Fthrow (Qtop_level, Qnil);
1157 return 0; /* not reached */
1160 DEFUN ("x-debug-mode", Fx_debug_mode, 1, 2, 0, /*
1161 With a true arg, make the connection to the X server synchronous.
1162 With false, make it asynchronous. Synchronous connections are much slower,
1163 but are useful for debugging. (If you get X errors, make the connection
1164 synchronous, and use a debugger to set a breakpoint on `x_error_handler'.
1165 Your backtrace of the C stack will now be useful. In asynchronous mode,
1166 the stack above `x_error_handler' isn't helpful because of buffering.)
1167 If DEVICE is not specified, the selected device is assumed.
1169 Calling this function is the same as calling the C function `XSynchronize',
1170 or starting the program with the `-sync' command line argument.
1174 struct device *d = decode_x_device (device);
1176 XSynchronize (DEVICE_X_DISPLAY (d), !NILP (arg));
1179 message ("X connection is synchronous");
1181 message ("X connection is asynchronous");
1187 /************************************************************************/
1189 /************************************************************************/
1191 #if 0 /* bah humbug. The whole "widget == resource" stuff is such
1192 a crock of shit that I'm just going to ignore it all. */
1194 /* If widget is NULL, we are retrieving device or global face data. */
1197 construct_name_list (Display *display, Widget widget, char *fake_name,
1198 char *fake_class, char *name, char *class)
1200 char *stack [100][2];
1203 char *name_tail, *class_tail;
1207 for (this = widget; this; this = XtParent (this))
1209 stack [count][0] = this->core.name;
1210 stack [count][1] = XtClass (this)->core_class.class_name;
1215 else if (fake_name && fake_class)
1217 stack [count][0] = fake_name;
1218 stack [count][1] = fake_class;
1222 /* The root widget is an application shell; resource lookups use the
1223 specified application name and application class in preference to
1224 the name/class of that widget (which is argv[0] / "ApplicationShell").
1225 Generally the app name and class will be argv[0] / "Emacs" but
1226 the former can be set via the -name command-line option, and the
1227 latter can be set by changing `x-emacs-application-class' in
1230 XtGetApplicationNameAndClass (display,
1239 for (; count >= 0; count--)
1241 strcat (name_tail, stack [count][0]);
1242 for (; *name_tail; name_tail++)
1243 if (*name_tail == '.') *name_tail = '_';
1244 strcat (name_tail, ".");
1247 strcat (class_tail, stack [count][1]);
1248 for (; *class_tail; class_tail++)
1249 if (*class_tail == '.') *class_tail = '_';
1250 strcat (class_tail, ".");
1257 /* strcasecmp() is not sufficiently portable or standard,
1258 and it's easier just to write our own. */
1260 ascii_strcasecmp (const char *s1, const char *s2)
1266 if (c1 >= 'A' && c1 <= 'Z') c1 += 'a' - 'A';
1267 if (c2 >= 'A' && c2 <= 'Z') c2 += 'a' - 'A';
1268 if (c1 != c2) return c1 - c2;
1269 if (c1 == '\0') return 0;
1273 static char_dynarr *name_char_dynarr;
1274 static char_dynarr *class_char_dynarr;
1276 /* Given a locale and device specification from x-get-resource or
1277 x-get-resource-prefix, return the resource prefix and display to
1278 fetch the resource on. */
1281 x_get_resource_prefix (Lisp_Object locale, Lisp_Object device,
1282 Display **display_out, char_dynarr *name,
1287 if (NILP (Fvalid_specifier_locale_p (locale)))
1288 signal_simple_error ("Invalid locale", locale);
1289 if (WINDOWP (locale))
1290 /* #### I can't come up with any coherent way of naming windows.
1291 By relative position? That seems tricky because windows
1292 can change position, be split, etc. By order of creation?
1293 That seems less than useful. */
1294 signal_simple_error ("Windows currently can't be resourced", locale);
1296 if (!NILP (device) && !DEVICEP (device))
1297 CHECK_DEVICE (device);
1298 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device)))
1302 device = DFW_DEVICE (locale);
1303 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device)))
1306 device = Vdefault_x_device;
1314 *display_out = DEVICE_X_DISPLAY (XDEVICE (device));
1317 char *appname, *appclass;
1318 int name_len, class_len;
1319 XtGetApplicationNameAndClass (*display_out, &appname, &appclass);
1320 name_len = strlen (appname);
1321 class_len = strlen (appclass);
1322 Dynarr_add_many (name , appname, name_len);
1323 Dynarr_add_many (class, appclass, class_len);
1324 validify_resource_component (Dynarr_atp (name, 0), name_len);
1325 validify_resource_component (Dynarr_atp (class, 0), class_len);
1328 if (EQ (locale, Qglobal))
1330 if (BUFFERP (locale))
1332 Dynarr_add_literal_string (name, ".buffer.");
1333 /* we know buffer is live; otherwise we got an error above. */
1334 Dynarr_add_validified_lisp_string (name, Fbuffer_name (locale));
1335 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsBuffer");
1337 else if (FRAMEP (locale))
1339 Dynarr_add_literal_string (name, ".frame.");
1340 /* we know frame is live; otherwise we got an error above. */
1341 Dynarr_add_validified_lisp_string (name, Fframe_name (locale));
1342 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsFrame");
1346 assert (DEVICEP (locale));
1347 Dynarr_add_literal_string (name, ".device.");
1348 /* we know device is live; otherwise we got an error above. */
1349 Dynarr_add_validified_lisp_string (name, Fdevice_name (locale));
1350 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsDevice");
1355 DEFUN ("x-get-resource", Fx_get_resource, 3, 6, 0, /*
1356 Retrieve an X resource from the resource manager.
1358 The first arg is the name of the resource to retrieve, such as "font".
1359 The second arg is the class of the resource to retrieve, such as "Font".
1360 The third arg must be one of the symbols 'string, 'integer, 'natnum, or
1361 'boolean, specifying the type of object that the database is searched for.
1362 The fourth arg is the locale to search for the resources on, and can
1363 currently be a buffer, a frame, a device, or 'global. If omitted, it
1364 defaults to 'global.
1365 The fifth arg is the device to search for the resources on. (The resource
1366 database for a particular device is constructed by combining non-device-
1367 specific resources such as any command-line resources specified and any
1368 app-defaults files found [or the fallback resources supplied by XEmacs,
1369 if no app-defaults file is found] with device-specific resources such as
1370 those supplied using xrdb.) If omitted, it defaults to the device of
1371 LOCALE, if a device can be derived (i.e. if LOCALE is a frame or device),
1372 and otherwise defaults to the value of `default-x-device'.
1373 The sixth arg NOERROR, if non-nil, means do not signal an error if a
1374 bogus resource specification was retrieved (e.g. if a non-integer was
1375 given when an integer was requested). In this case, a warning is issued
1376 instead, unless NOERROR is t, in which case no warning is issued.
1378 The resource names passed to this function are looked up relative to the
1381 If you want to search for a subresource, you just need to specify the
1382 resource levels in NAME and CLASS. For example, NAME could be
1383 "modeline.attributeFont", and CLASS "Face.AttributeFont".
1387 1) If LOCALE is a buffer, a call
1389 (x-get-resource "foreground" "Foreground" 'string SOME-BUFFER)
1391 is an interface to a C call something like
1393 XrmGetResource (db, "xemacs.buffer.BUFFER-NAME.foreground",
1394 "Emacs.EmacsLocaleType.EmacsBuffer.Foreground",
1397 2) If LOCALE is a frame, a call
1399 (x-get-resource "foreground" "Foreground" 'string SOME-FRAME)
1401 is an interface to a C call something like
1403 XrmGetResource (db, "xemacs.frame.FRAME-NAME.foreground",
1404 "Emacs.EmacsLocaleType.EmacsFrame.Foreground",
1407 3) If LOCALE is a device, a call
1409 (x-get-resource "foreground" "Foreground" 'string SOME-DEVICE)
1411 is an interface to a C call something like
1413 XrmGetResource (db, "xemacs.device.DEVICE-NAME.foreground",
1414 "Emacs.EmacsLocaleType.EmacsDevice.Foreground",
1417 4) If LOCALE is 'global, a call
1419 (x-get-resource "foreground" "Foreground" 'string 'global)
1421 is an interface to a C call something like
1423 XrmGetResource (db, "xemacs.foreground",
1427 Note that for 'global, no prefix is added other than that of the
1428 application itself; thus, you can use this locale to retrieve
1429 arbitrary application resources, if you really want to.
1431 The returned value of this function is nil if the queried resource is not
1432 found. If the third arg is `string', a string is returned, and if it is
1433 `integer', an integer is returned. If the third arg is `boolean', then the
1434 returned value is the list (t) for true, (nil) for false, and is nil to
1435 mean ``unspecified''.
1437 (name, class, type, locale, device, noerror))
1439 char* name_string, *class_string;
1443 Error_behavior errb = decode_error_behavior_flag (noerror);
1445 CHECK_STRING (name);
1446 CHECK_STRING (class);
1447 CHECK_SYMBOL (type);
1449 Dynarr_reset (name_char_dynarr);
1450 Dynarr_reset (class_char_dynarr);
1452 x_get_resource_prefix (locale, device, &display,
1453 name_char_dynarr, class_char_dynarr);
1457 db = XtDatabase (display);
1459 Dynarr_add (name_char_dynarr, '.');
1460 Dynarr_add_lisp_string (name_char_dynarr, name);
1461 Dynarr_add (class_char_dynarr, '.');
1462 Dynarr_add_lisp_string (class_char_dynarr, class);
1463 Dynarr_add (name_char_dynarr, '\0');
1464 Dynarr_add (class_char_dynarr, '\0');
1466 name_string = Dynarr_atp (name_char_dynarr, 0);
1467 class_string = Dynarr_atp (class_char_dynarr, 0);
1471 XrmName namelist[100];
1472 XrmClass classlist[100];
1473 XrmName *namerest = namelist;
1474 XrmClass *classrest = classlist;
1475 XrmRepresentation xrm_type;
1476 XrmRepresentation string_quark;
1478 XrmStringToNameList (name_string, namelist);
1479 XrmStringToClassList (class_string, classlist);
1480 string_quark = XrmStringToQuark ("String");
1482 /* ensure that they have the same length */
1483 while (namerest[0] && classrest[0])
1484 namerest++, classrest++;
1485 if (namerest[0] || classrest[0])
1486 signal_simple_error_2
1487 ("class list and name list must be the same length", name, class);
1488 result = XrmQGetResource (db, namelist, classlist, &xrm_type, &xrm_value);
1490 if (result != True || xrm_type != string_quark)
1492 raw_result = (char *) xrm_value.addr;
1495 if (EQ (type, Qstring))
1496 return build_string (raw_result);
1497 else if (EQ (type, Qboolean))
1499 if (!ascii_strcasecmp (raw_result, "off") ||
1500 !ascii_strcasecmp (raw_result, "false") ||
1501 !ascii_strcasecmp (raw_result, "no"))
1502 return Fcons (Qnil, Qnil);
1503 if (!ascii_strcasecmp (raw_result, "on") ||
1504 !ascii_strcasecmp (raw_result, "true") ||
1505 !ascii_strcasecmp (raw_result, "yes"))
1506 return Fcons (Qt, Qnil);
1507 return maybe_continuable_error
1509 "can't convert %s: %s to a Boolean", name_string, raw_result);
1511 else if (EQ (type, Qinteger) || EQ (type, Qnatnum))
1515 if (1 != sscanf (raw_result, "%d%c", &i, &c))
1516 return maybe_continuable_error
1518 "can't convert %s: %s to an integer", name_string, raw_result);
1519 else if (EQ (type, Qnatnum) && i < 0)
1520 return maybe_continuable_error
1522 "invalid numerical value %d for resource %s", i, name_string);
1524 return make_int (i);
1528 return maybe_signal_continuable_error
1529 (Qwrong_type_argument,
1530 list2 (build_translated_string
1531 ("should be string, integer, natnum or boolean"),
1537 DEFUN ("x-get-resource-prefix", Fx_get_resource_prefix, 1, 2, 0, /*
1538 Return the resource prefix for LOCALE on DEVICE.
1539 The resource prefix is the strings used to prefix resources if
1540 the LOCALE and DEVICE arguments were passed to `x-get-resource'.
1541 The returned value is a cons of a name prefix and a class prefix.
1542 For example, if LOCALE is a frame, the returned value might be
1543 \("xemacs.frame.FRAME-NAME" . "Emacs.EmacsLocaleType.EmacsFrame").
1544 If no valid X device for resourcing can be obtained, this function
1545 returns nil. (In such a case, `x-get-resource' would always return nil.)
1551 Dynarr_reset (name_char_dynarr );
1552 Dynarr_reset (class_char_dynarr);
1554 x_get_resource_prefix (locale, device, &display,
1555 name_char_dynarr, class_char_dynarr);
1559 return Fcons (make_string ((Bufbyte *) Dynarr_atp (name_char_dynarr, 0),
1560 Dynarr_length (name_char_dynarr)),
1561 make_string ((Bufbyte *) Dynarr_atp (class_char_dynarr, 0),
1562 Dynarr_length (class_char_dynarr)));
1565 DEFUN ("x-put-resource", Fx_put_resource, 1, 2, 0, /*
1566 Add a resource to the resource database for DEVICE.
1567 RESOURCE-LINE specifies the resource to add and should be a
1568 standard resource specification.
1570 (resource_line, device))
1572 struct device *d = decode_device (device);
1573 char *str, *colon_pos;
1575 CHECK_STRING (resource_line);
1576 str = (char *) XSTRING_DATA (resource_line);
1577 if (!(colon_pos = strchr (str, ':')) || strchr (str, '\n'))
1579 signal_simple_error ("Invalid resource line", resource_line);
1581 /* Only the following chars are allowed before the colon */
1582 " \t.*?abcdefghijklmnopqrstuvwxyz"
1583 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-")
1584 != (size_t) (colon_pos - str))
1589 XrmDatabase db = XtDatabase (DEVICE_X_DISPLAY (d));
1590 XrmPutLineResource (&db, str);
1597 /************************************************************************/
1598 /* display information functions */
1599 /************************************************************************/
1601 DEFUN ("default-x-device", Fdefault_x_device, 0, 0, 0, /*
1602 Return the default X device for resourcing.
1603 This is the first-created X device that still exists.
1607 return Vdefault_x_device;
1610 DEFUN ("x-display-visual-class", Fx_display_visual_class, 0, 1, 0, /*
1611 Return the visual class of the X display DEVICE is using.
1612 This can be altered from the default at startup using the XResource "EmacsVisual".
1613 The returned value will be one of the symbols `static-gray', `gray-scale',
1614 `static-color', `pseudo-color', `true-color', or `direct-color'.
1618 Visual *vis = DEVICE_X_VISUAL (decode_x_device (device));
1621 case StaticGray: return intern ("static-gray");
1622 case GrayScale: return intern ("gray-scale");
1623 case StaticColor: return intern ("static-color");
1624 case PseudoColor: return intern ("pseudo-color");
1625 case TrueColor: return intern ("true-color");
1626 case DirectColor: return intern ("direct-color");
1628 error ("display has an unknown visual class");
1629 return Qnil; /* suppress compiler warning */
1633 DEFUN ("x-display-visual-depth", Fx_display_visual_depth, 0, 1, 0, /*
1634 Return the bitplane depth of the visual the X display DEVICE is using.
1638 return make_int (DEVICE_X_DEPTH (decode_x_device (device)));
1642 x_device_system_metrics (struct device *d,
1643 enum device_metrics m)
1645 Display *dpy = DEVICE_X_DISPLAY (d);
1649 case DM_size_device:
1650 return Fcons (make_int (DisplayWidth (dpy, DefaultScreen (dpy))),
1651 make_int (DisplayHeight (dpy, DefaultScreen (dpy))));
1652 case DM_size_device_mm:
1653 return Fcons (make_int (DisplayWidthMM (dpy, DefaultScreen (dpy))),
1654 make_int (DisplayHeightMM (dpy, DefaultScreen (dpy))));
1655 case DM_num_bit_planes:
1656 return make_int (DisplayPlanes (dpy, DefaultScreen (dpy)));
1657 case DM_num_color_cells:
1658 return make_int (DisplayCells (dpy, DefaultScreen (dpy)));
1659 default: /* No such device metric property for X devices */
1664 DEFUN ("x-server-vendor", Fx_server_vendor, 0, 1, 0, /*
1665 Return the vendor ID string of the X server DEVICE is on.
1666 Return the empty string if the vendor ID string cannot be determined.
1670 Display *dpy = get_x_display (device);
1671 char *vendor = ServerVendor (dpy);
1673 return build_string (vendor ? vendor : "");
1676 DEFUN ("x-server-version", Fx_server_version, 0, 1, 0, /*
1677 Return the version numbers of the X server DEVICE is on.
1678 The returned value is a list of three integers: the major and minor
1679 version numbers of the X Protocol in use, and the vendor-specific release
1680 number. See also `x-server-vendor'.
1684 Display *dpy = get_x_display (device);
1686 return list3 (make_int (ProtocolVersion (dpy)),
1687 make_int (ProtocolRevision (dpy)),
1688 make_int (VendorRelease (dpy)));
1691 DEFUN ("x-valid-keysym-name-p", Fx_valid_keysym_name_p, 1, 1, 0, /*
1692 Return true if KEYSYM names a keysym that the X library knows about.
1693 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1694 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1698 const char *keysym_ext;
1700 CHECK_STRING (keysym);
1701 LISP_STRING_TO_EXTERNAL (keysym, keysym_ext, Qctext);
1703 return XStringToKeysym (keysym_ext) ? Qt : Qnil;
1706 DEFUN ("x-keysym-hash-table", Fx_keysym_hash_table, 0, 1, 0, /*
1707 Return a hash table containing a key for all keysyms on DEVICE.
1708 DEVICE must be an X11 display device. See `x-keysym-on-keyboard-p'.
1712 struct device *d = decode_device (device);
1713 if (!DEVICE_X_P (d))
1714 signal_simple_error ("Not an X device", device);
1716 return DEVICE_X_DATA (d)->x_keysym_map_hash_table;
1719 DEFUN ("x-keysym-on-keyboard-sans-modifiers-p", Fx_keysym_on_keyboard_sans_modifiers_p,
1721 Return true if KEYSYM names a key on the keyboard of DEVICE.
1722 More precisely, return true if pressing a physical key
1723 on the keyboard of DEVICE without any modifier keys generates KEYSYM.
1724 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1725 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1726 The keysym name can be provided in two forms:
1727 - if keysym is a string, it must be the name as known to X windows.
1728 - if keysym is a symbol, it must be the name as known to XEmacs.
1729 The two names differ in capitalization and underscoring.
1733 struct device *d = decode_device (device);
1734 if (!DEVICE_X_P (d))
1735 signal_simple_error ("Not an X device", device);
1737 return (EQ (Qsans_modifiers,
1738 Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ?
1743 DEFUN ("x-keysym-on-keyboard-p", Fx_keysym_on_keyboard_p, 1, 2, 0, /*
1744 Return true if KEYSYM names a key on the keyboard of DEVICE.
1745 More precisely, return true if some keystroke (possibly including modifiers)
1746 on the keyboard of DEVICE keys generates KEYSYM.
1747 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1748 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1749 The keysym name can be provided in two forms:
1750 - if keysym is a string, it must be the name as known to X windows.
1751 - if keysym is a symbol, it must be the name as known to XEmacs.
1752 The two names differ in capitalization and underscoring.
1756 struct device *d = decode_device (device);
1757 if (!DEVICE_X_P (d))
1758 signal_simple_error ("Not an X device", device);
1760 return (NILP (Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ?
1765 /************************************************************************/
1766 /* grabs and ungrabs */
1767 /************************************************************************/
1769 DEFUN ("x-grab-pointer", Fx_grab_pointer, 0, 3, 0, /*
1770 Grab the pointer and restrict it to its current window.
1771 If optional DEVICE argument is nil, the default device will be used.
1772 If optional CURSOR argument is non-nil, change the pointer shape to that
1773 until `x-ungrab-pointer' is called (it should be an object returned by the
1774 `make-cursor-glyph' function).
1775 If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all
1776 keyboard events during the grab.
1777 Returns t if the grab is successful, nil otherwise.
1779 (device, cursor, ignore_keyboard))
1782 int pointer_mode, result;
1783 struct device *d = decode_x_device (device);
1787 CHECK_POINTER_GLYPH (cursor);
1788 cursor = glyph_image_instance (cursor, device, ERROR_ME, 0);
1791 if (!NILP (ignore_keyboard))
1792 pointer_mode = GrabModeSync;
1794 pointer_mode = GrabModeAsync;
1796 w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d)));
1798 /* #### Possibly this needs to gcpro the cursor somehow, but it doesn't
1799 seem to cause a problem if XFreeCursor is called on a cursor in use
1800 in a grab; I suppose the X server counts the grab as a reference
1801 and doesn't free it until it exits? */
1802 result = XGrabPointer (DEVICE_X_DISPLAY (d), w,
1807 PointerMotionHintMask,
1808 GrabModeAsync, /* Keep pointer events flowing */
1809 pointer_mode, /* Stall keyboard events */
1810 w, /* Stay in this window */
1812 : XIMAGE_INSTANCE_X_CURSOR (cursor)),
1814 return (result == GrabSuccess) ? Qt : Qnil;
1817 DEFUN ("x-ungrab-pointer", Fx_ungrab_pointer, 0, 1, 0, /*
1818 Release a pointer grab made with `x-grab-pointer'.
1819 If optional first arg DEVICE is nil the default device is used.
1820 If it is t the pointer will be released on all X devices.
1824 if (!EQ (device, Qt))
1826 Display *dpy = get_x_display (device);
1827 XUngrabPointer (dpy, CurrentTime);
1831 Lisp_Object devcons, concons;
1833 DEVICE_LOOP_NO_BREAK (devcons, concons)
1835 struct device *d = XDEVICE (XCAR (devcons));
1838 XUngrabPointer (DEVICE_X_DISPLAY (d), CurrentTime);
1845 DEFUN ("x-grab-keyboard", Fx_grab_keyboard, 0, 1, 0, /*
1846 Grab the keyboard on the given device (defaulting to the selected one).
1847 So long as the keyboard is grabbed, all keyboard events will be delivered
1848 to emacs -- it is not possible for other X clients to eavesdrop on them.
1849 Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect).
1850 Returns t if the grab is successful, nil otherwise.
1854 struct device *d = decode_x_device (device);
1855 Window w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d)));
1856 Display *dpy = DEVICE_X_DISPLAY (d);
1859 status = XGrabKeyboard (dpy, w, True,
1860 /* I don't really understand sync-vs-async
1861 grabs, but this is what xterm does. */
1862 GrabModeAsync, GrabModeAsync,
1863 /* Use the timestamp of the last user action
1864 read by emacs proper; xterm uses CurrentTime
1865 but there's a comment that says "wrong"...
1866 (Despite the name this is the time of the
1867 last key or mouse event.) */
1868 DEVICE_X_MOUSE_TIMESTAMP (d));
1869 if (status == GrabSuccess)
1871 /* The XUngrabKeyboard should generate a FocusIn back to this
1872 window but it doesn't unless we explicitly set focus to the
1873 window first (which should already have it. The net result
1874 is that without this call when x-ungrab-keyboard is called
1875 the selected frame ends up not having focus. */
1876 XSetInputFocus (dpy, w, RevertToParent, DEVICE_X_MOUSE_TIMESTAMP (d));
1883 DEFUN ("x-ungrab-keyboard", Fx_ungrab_keyboard, 0, 1, 0, /*
1884 Release a keyboard grab made with `x-grab-keyboard'.
1888 Display *dpy = get_x_display (device);
1889 XUngrabKeyboard (dpy, CurrentTime);
1893 DEFUN ("x-get-font-path", Fx_get_font_path, 0, 1, 0, /*
1894 Get the X Server's font path.
1896 See also `x-set-font-path'.
1900 Display *dpy = get_x_display (device);
1902 const char **directories = (const char **) XGetFontPath (dpy, &ndirs_return);
1903 Lisp_Object font_path = Qnil;
1906 signal_simple_error ("Can't get X font path", device);
1908 while (ndirs_return--)
1909 font_path = Fcons (build_ext_string (directories[ndirs_return],
1916 DEFUN ("x-set-font-path", Fx_set_font_path, 1, 2, 0, /*
1917 Set the X Server's font path to FONT-PATH.
1919 There is only one font path per server, not one per client. Use this
1920 sparingly. It uncaches all of the X server's font information.
1922 Font directories should end in the path separator and should contain
1923 a file called fonts.dir usually created with the program mkfontdir.
1925 Setting the FONT-PATH to nil tells the X server to use the default
1928 See also `x-get-font-path'.
1930 (font_path, device))
1932 Display *dpy = get_x_display (device);
1933 Lisp_Object path_entry;
1934 const char **directories;
1937 EXTERNAL_LIST_LOOP (path_entry, font_path)
1939 CHECK_STRING (XCAR (path_entry));
1943 directories = alloca_array (const char *, ndirs);
1945 EXTERNAL_LIST_LOOP (path_entry, font_path)
1947 LISP_STRING_TO_EXTERNAL (XCAR (path_entry), directories[i++], Qfile_name);
1950 expect_x_error (dpy);
1951 XSetFontPath (dpy, (char **) directories, ndirs);
1952 signal_if_x_error (dpy, 1/*resumable_p*/);
1958 /************************************************************************/
1959 /* initialization */
1960 /************************************************************************/
1963 syms_of_device_x (void)
1965 DEFSUBR (Fx_debug_mode);
1966 DEFSUBR (Fx_get_resource);
1967 DEFSUBR (Fx_get_resource_prefix);
1968 DEFSUBR (Fx_put_resource);
1970 DEFSUBR (Fdefault_x_device);
1971 DEFSUBR (Fx_display_visual_class);
1972 DEFSUBR (Fx_display_visual_depth);
1973 DEFSUBR (Fx_server_vendor);
1974 DEFSUBR (Fx_server_version);
1975 DEFSUBR (Fx_valid_keysym_name_p);
1976 DEFSUBR (Fx_keysym_hash_table);
1977 DEFSUBR (Fx_keysym_on_keyboard_p);
1978 DEFSUBR (Fx_keysym_on_keyboard_sans_modifiers_p);
1980 DEFSUBR (Fx_grab_pointer);
1981 DEFSUBR (Fx_ungrab_pointer);
1982 DEFSUBR (Fx_grab_keyboard);
1983 DEFSUBR (Fx_ungrab_keyboard);
1985 DEFSUBR (Fx_get_font_path);
1986 DEFSUBR (Fx_set_font_path);
1988 defsymbol (&Qx_error, "x-error");
1989 defsymbol (&Qinit_pre_x_win, "init-pre-x-win");
1990 defsymbol (&Qinit_post_x_win, "init-post-x-win");
1994 reinit_console_type_create_device_x (void)
1996 /* Initialize variables to speed up X resource interactions */
1997 const char *valid_resource_chars =
1998 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_";
1999 while (*valid_resource_chars)
2000 valid_resource_char_p[(unsigned int) (*valid_resource_chars++)] = 1;
2002 name_char_dynarr = Dynarr_new (char);
2003 class_char_dynarr = Dynarr_new (char);
2007 console_type_create_device_x (void)
2009 reinit_console_type_create_device_x ();
2010 CONSOLE_HAS_METHOD (x, init_device);
2011 CONSOLE_HAS_METHOD (x, finish_init_device);
2012 CONSOLE_HAS_METHOD (x, mark_device);
2013 CONSOLE_HAS_METHOD (x, delete_device);
2014 CONSOLE_HAS_METHOD (x, device_system_metrics);
2018 reinit_vars_of_device_x (void)
2023 in_resource_setting = 0;
2027 vars_of_device_x (void)
2029 reinit_vars_of_device_x ();
2031 DEFVAR_LISP ("x-emacs-application-class", &Vx_emacs_application_class /*
2032 The X application class of the XEmacs process.
2033 This controls, among other things, the name of the `app-defaults' file
2034 that XEmacs will use. For changes to this variable to take effect, they
2035 must be made before the connection to the X server is initialized, that is,
2036 this variable may only be changed before emacs is dumped, or by setting it
2037 in the file lisp/term/x-win.el.
2039 If this variable is nil before the connection to the X server is first
2040 initialized (which it is by default), the X resource database will be
2041 consulted and the value will be set according to whether any resources
2042 are found for the application class `XEmacs'. If the user has set any
2043 resources for the XEmacs application class, the XEmacs process will use
2044 the application class `XEmacs'. Otherwise, the XEmacs process will use
2045 the application class `Emacs' which is backwards compatible to previous
2046 XEmacs versions but may conflict with resources intended for GNU Emacs.
2048 Vx_emacs_application_class = Qnil;
2050 DEFVAR_LISP ("x-initial-argv-list", &Vx_initial_argv_list /*
2051 You don't want to know.
2052 This is used during startup to communicate the remaining arguments in
2053 `command-line-args-left' to the C code, which passes the args to
2054 the X initialization code, which removes some args, and then the
2055 args are placed back into `x-initial-arg-list' and thence into
2056 `command-line-args-left'. Perhaps `command-line-args-left' should
2059 Vx_initial_argv_list = Qnil;
2061 #if defined(MULE) && (defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET))
2062 DEFVAR_LISP ("x-app-defaults-directory", &Vx_app_defaults_directory /*
2063 Used by the Lisp code to communicate to the low level X initialization
2064 where the localized init files are.
2066 Vx_app_defaults_directory = Qnil;
2071 staticpro (&Vdefault_x_device);
2072 Vdefault_x_device = Qnil;