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"
57 Lisp_Object Vdefault_x_device;
58 #if defined(MULE) && (defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET))
59 Lisp_Object Vx_app_defaults_directory;
62 /* Qdisplay in general.c */
64 Lisp_Object Qinit_pre_x_win, Qinit_post_x_win;
66 /* The application class of Emacs. */
67 Lisp_Object Vx_emacs_application_class;
69 Lisp_Object Vx_initial_argv_list; /* #### ugh! */
71 static XrmOptionDescRec emacs_options[] =
73 {"-geometry", ".geometry", XrmoptionSepArg, NULL},
74 {"-iconic", ".iconic", XrmoptionNoArg, "yes"},
76 {"-internal-border-width", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL},
77 {"-ib", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL},
78 {"-scrollbar-width", "*EmacsFrame.scrollBarWidth", XrmoptionSepArg, NULL},
79 {"-scrollbar-height", "*EmacsFrame.scrollBarHeight", XrmoptionSepArg, NULL},
81 {"-privatecolormap", ".privateColormap", XrmoptionNoArg, "yes"},
82 {"-visual", ".EmacsVisual", XrmoptionSepArg, NULL},
84 /* #### Beware! If the type of the shell changes, update this. */
85 {"-T", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
86 {"-wn", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
87 {"-title", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL},
89 {"-iconname", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL},
90 {"-in", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL},
91 {"-mc", "*pointerColor", XrmoptionSepArg, NULL},
92 {"-cr", "*cursorColor", XrmoptionSepArg, NULL},
93 {"-fontset", "*FontSet", XrmoptionSepArg, NULL},
96 /* Functions to synchronize mirroring resources and specifiers */
97 int in_resource_setting;
99 /************************************************************************/
100 /* helper functions */
101 /************************************************************************/
103 /* JH 97/11/25 removed the static declaration because I need it during setup in event-Xt... */
104 struct device * get_device_from_display_1 (Display *dpy);
106 get_device_from_display_1 (Display *dpy)
108 Lisp_Object devcons, concons;
110 DEVICE_LOOP_NO_BREAK (devcons, concons)
112 struct device *d = XDEVICE (XCAR (devcons));
113 if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d) == dpy)
121 get_device_from_display (Display *dpy)
123 struct device *d = get_device_from_display_1 (dpy);
125 #if !defined(INFODOCK)
126 # define FALLBACK_RESOURCE_NAME "xemacs"
128 # define FALLBACK_RESOURCE_NAME "infodock"
132 /* This isn't one of our displays. Let's crash? */
134 ("\n%s: Fatal X Condition. Asked about display we don't own: \"%s\"\n",
135 (STRINGP (Vinvocation_name) ?
136 (char *) XSTRING_DATA (Vinvocation_name) : FALLBACK_RESOURCE_NAME),
137 DisplayString (dpy) ? DisplayString (dpy) : "???");
141 #undef FALLBACK_RESOURCE_NAME
147 decode_x_device (Lisp_Object device)
149 XSETDEVICE (device, decode_device (device));
150 CHECK_X_DEVICE (device);
151 return XDEVICE (device);
155 get_x_display (Lisp_Object device)
157 return DEVICE_X_DISPLAY (decode_x_device (device));
161 /************************************************************************/
162 /* initializing an X connection */
163 /************************************************************************/
166 allocate_x_device_struct (struct device *d)
168 d->device_data = xnew_and_zero (struct x_device);
172 Xatoms_of_device_x (struct device *d)
174 Display *D = DEVICE_X_DISPLAY (d);
176 DEVICE_XATOM_WM_PROTOCOLS (d) = XInternAtom (D, "WM_PROTOCOLS", False);
177 DEVICE_XATOM_WM_DELETE_WINDOW(d) = XInternAtom (D, "WM_DELETE_WINDOW",False);
178 DEVICE_XATOM_WM_SAVE_YOURSELF(d) = XInternAtom (D, "WM_SAVE_YOURSELF",False);
179 DEVICE_XATOM_WM_TAKE_FOCUS (d) = XInternAtom (D, "WM_TAKE_FOCUS", False);
180 DEVICE_XATOM_WM_STATE (d) = XInternAtom (D, "WM_STATE", False);
184 sanity_check_geometry_resource (Display *dpy)
186 char *app_name, *app_class, *s;
187 char buf1 [255], buf2 [255];
190 XtGetApplicationNameAndClass (dpy, &app_name, &app_class);
191 strcpy (buf1, app_name);
192 strcpy (buf2, app_class);
193 for (s = buf1; *s; s++) if (*s == '.') *s = '_';
194 strcat (buf1, "._no_._such_._resource_.geometry");
195 strcat (buf2, "._no_._such_._resource_.Geometry");
196 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)
198 warn_when_safe (Qgeometry, Qerror,
200 "Apparently \"%s*geometry: %s\" or \"%s*geometry: %s\" was\n"
201 "specified in the resource database. Specifying \"*geometry\" will make\n"
202 "XEmacs (and most other X programs) malfunction in obscure ways. (i.e.\n"
203 "the Xt or Xm libraries will probably crash, which is a very bad thing.)\n"
204 "You should always use \".geometry\" or \"*EmacsFrame.geometry\" instead.\n",
205 app_name, (char *) value.addr,
206 app_class, (char *) value.addr);
207 suppress_early_error_handler_backtrace = 1;
208 error ("Invalid geometry resource");
213 x_init_device_class (struct device *d)
215 if (DEVICE_X_DEPTH(d) > 2)
217 switch (DEVICE_X_VISUAL(d)->class)
221 DEVICE_CLASS (d) = Qgrayscale;
224 DEVICE_CLASS (d) = Qcolor;
228 DEVICE_CLASS (d) = Qmono;
232 * Figure out what application name to use for xemacs
234 * Since we have decomposed XtOpenDisplay into XOpenDisplay and
235 * XtDisplayInitialize, we no longer get this for free.
237 * If there is a `-name' argument in argv, use that.
238 * Otherwise use the last component of argv[0].
240 * I have removed the gratuitous use of getenv("RESOURCE_NAME")
241 * which was in X11R5, but left the matching of any prefix of `-name'.
242 * Finally, if all else fails, return `xemacs', as it is more
243 * appropriate (X11R5 returns `main').
246 compute_x_app_name (int argc, char **argv)
251 for (i = 1; i < argc - 1; i++)
252 if (!strncmp(argv[i], "-name", max (2, strlen (argv[1]))))
255 if (argc > 0 && argv[0] && *argv[0])
256 return (ptr = strrchr (argv[0], '/')) ? ++ptr : argv[0];
262 * This function figures out whether the user has any resources of the
263 * form "XEmacs.foo" or "XEmacs*foo".
265 * Currently we only consult the display's global resources; to look
266 * for screen specific resources, we would need to also consult:
267 * xdefs = XScreenResourceString(ScreenOfDisplay(dpy, scrno));
270 have_xemacs_resources_in_xrdb (Display *dpy)
285 xdefs = XResourceManagerString (dpy); /* don't free - owned by X */
286 while (xdefs && *xdefs)
288 if (strncmp (xdefs, key, len) == 0 &&
289 (xdefs[len] == '*' || xdefs[len] == '.'))
292 while (*xdefs && *xdefs++ != '\n') /* find start of next entry.. */
299 /* Only the characters [-_A-Za-z0-9] are allowed in the individual
300 components of a resource. Convert invalid characters to `-' */
302 static char valid_resource_char_p[256];
305 validify_resource_component (char *str, size_t len)
307 for (; len; len--, str++)
308 if (!valid_resource_char_p[(unsigned char) (*str)])
313 Dynarr_add_validified_lisp_string (char_dynarr *cda, Lisp_Object str)
315 Bytecount len = XSTRING_LENGTH (str);
316 Dynarr_add_many (cda, (char *) XSTRING_DATA (str), len);
317 validify_resource_component (Dynarr_atp (cda, Dynarr_length (cda) - len), len);
321 /* compare visual info for qsorting */
323 x_comp_visual_info (const void *elem1, const void *elem2)
325 XVisualInfo *left, *right;
327 left = (XVisualInfo *)elem1;
328 right = (XVisualInfo *)elem2;
335 if ( left->depth > right->depth ) {
338 else if ( left->depth == right->depth ) {
339 if ( left->colormap_size > right->colormap_size )
341 if ( left->class > right->class )
343 else if ( left->class < right->class )
355 #define XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN
357 x_try_best_visual_class (Screen *screen, int scrnum, int visual_class)
359 Display *dpy = DisplayOfScreen (screen);
361 XVisualInfo *vi_out = NULL;
364 vi_in.class = visual_class;
365 vi_in.screen = scrnum;
366 vi_out = XGetVisualInfo (dpy, (VisualClassMask | VisualScreenMask),
372 for (i = 0, best = 0; i < out_count; i++)
373 /* It's better if it's deeper, or if it's the same depth with
374 more cells (does that ever happen? Well, it could...)
375 NOTE: don't allow pseudo color to get larger than 8! */
376 if (((vi_out [i].depth > vi_out [best].depth) ||
377 ((vi_out [i].depth == vi_out [best].depth) &&
378 (vi_out [i].colormap_size > vi_out [best].colormap_size)))
379 #ifdef XXX_IMAGE_LIBRARY_IS_SOMEWHAT_BROKEN
380 /* For now, the image library doesn't like PseudoColor visuals
381 of depths other than 1 or 8. Depths greater than 8 only occur
382 on machines which have TrueColor anyway, so probably we'll end
383 up using that (it is the one that `Best' would pick) but if a
384 PseudoColor visual is explicitly specified, pick the 8 bit one.
386 && (visual_class != PseudoColor ||
387 vi_out [i].depth == 1 ||
388 vi_out [i].depth == 8)
391 /* SGI has 30-bit deep visuals. Ignore them.
392 (We only have 24-bit data anyway.)
394 && (vi_out [i].depth <= 24)
397 visual = vi_out[best].visual;
398 XFree ((char *) vi_out);
406 x_get_visual_depth (Display *dpy, Visual *visual)
412 vi_in.visualid = XVisualIDFromVisual (visual);
413 vi_out = XGetVisualInfo (dpy, /*VisualScreenMask|*/VisualIDMask,
415 if (! vi_out) abort ();
416 d = vi_out [0].depth;
417 XFree ((char *) vi_out);
422 x_try_best_visual (Display *dpy, int scrnum)
424 Visual *visual = NULL;
425 Screen *screen = ScreenOfDisplay (dpy, scrnum);
426 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor))
427 && x_get_visual_depth (dpy, visual) >= 16 )
429 if ((visual = x_try_best_visual_class (screen, scrnum, PseudoColor)))
431 if ((visual = x_try_best_visual_class (screen, scrnum, TrueColor)))
433 #ifdef DIRECTCOLOR_WORKS
434 if ((visual = x_try_best_visual_class (screen, scrnum, DirectColor)))
438 visual = DefaultVisualOfScreen (screen);
439 if ( x_get_visual_depth (dpy, visual) >= 8 )
442 if ((visual = x_try_best_visual_class (screen, scrnum, StaticGray)))
444 if ((visual = x_try_best_visual_class (screen, scrnum, GrayScale)))
446 return DefaultVisualOfScreen (screen);
451 x_init_device (struct device *d, Lisp_Object props)
459 CONST char *app_class;
460 CONST char *app_name;
461 CONST char *disp_name;
462 Visual *visual = NULL;
463 int depth = 8; /* shut up the compiler */
467 int best_visual_found = 0;
469 XSETDEVICE (device, d);
470 display = DEVICE_CONNECTION (d);
472 allocate_x_device_struct (d);
474 make_argc_argv (Vx_initial_argv_list, &argc, &argv);
476 GET_C_STRING_CTEXT_DATA_ALLOCA (display, disp_name);
479 * Break apart the old XtOpenDisplay call into XOpenDisplay and
480 * XtDisplayInitialize so we can figure out whether there
481 * are any XEmacs resources in the resource database before
482 * we initialize Xt. This is so we can automagically support
483 * both `Emacs' and `XEmacs' application classes.
485 slow_down_interrupts ();
486 /* May not be needed but XtOpenDisplay could not deal with signals here. */
487 dpy = DEVICE_X_DISPLAY (d) = XOpenDisplay (disp_name);
488 speed_up_interrupts ();
492 suppress_early_error_handler_backtrace = 1;
493 signal_simple_error ("X server not responding\n", display);
496 if (STRINGP (Vx_emacs_application_class) &&
497 XSTRING_LENGTH (Vx_emacs_application_class) > 0)
498 GET_C_STRING_CTEXT_DATA_ALLOCA (Vx_emacs_application_class, app_class);
501 app_class = (NILP (Vx_emacs_application_class) &&
502 have_xemacs_resources_in_xrdb (dpy))
509 /* need to update Vx_emacs_application_class: */
510 Vx_emacs_application_class = build_string (app_class);
513 slow_down_interrupts ();
514 /* May not be needed but XtOpenDisplay could not deal with signals here.
516 XtDisplayInitialize (Xt_app_con, dpy, compute_x_app_name (argc, argv),
517 app_class, emacs_options,
518 XtNumber (emacs_options), &argc, argv);
519 speed_up_interrupts ();
521 screen = DefaultScreen (dpy);
522 if (NILP (Vdefault_x_device))
523 Vdefault_x_device = device;
526 #if defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET)
528 /* Read in locale-specific resources from
529 data-directory/app-defaults/$LANG/Emacs.
530 This is in addition to the standard app-defaults files, and
531 does not override resources defined elsewhere */
532 CONST char *data_dir;
534 XrmDatabase db = XtDatabase (dpy); /* #### XtScreenDatabase(dpy) ? */
535 CONST char *locale = XrmLocaleOfDatabase (db);
537 if (STRINGP (Vx_app_defaults_directory) &&
538 XSTRING_LENGTH (Vx_app_defaults_directory) > 0)
540 GET_C_STRING_FILENAME_DATA_ALLOCA(Vx_app_defaults_directory, data_dir);
541 path = (char *)alloca (strlen (data_dir) + strlen (locale) + 7);
542 sprintf (path, "%s%s/Emacs", data_dir, locale);
543 if (!access (path, R_OK))
544 XrmCombineFileDatabase (path, &db, False);
546 else if (STRINGP (Vdata_directory) && XSTRING_LENGTH (Vdata_directory) > 0)
548 GET_C_STRING_FILENAME_DATA_ALLOCA (Vdata_directory, data_dir);
549 path = (char *)alloca (strlen (data_dir) + 13 + strlen (locale) + 7);
550 sprintf (path, "%sapp-defaults/%s/Emacs", data_dir, locale);
551 if (!access (path, R_OK))
552 XrmCombineFileDatabase (path, &db, False);
555 #endif /* LWLIB_MENUBARS_MOTIF or HAVE_XIM USE_XFONTSET */
558 if (NILP (DEVICE_NAME (d)))
559 DEVICE_NAME (d) = display;
561 /* We're going to modify the string in-place, so be a nice XEmacs */
562 DEVICE_NAME (d) = Fcopy_sequence (DEVICE_NAME (d));
563 /* colons and periods can't appear in individual elements of resource
566 XtGetApplicationNameAndClass (dpy, (char **) &app_name, (char **) &app_class);
567 /* search for a matching visual if requested by the user, or setup the display default */
569 int resource_name_length = max (sizeof (".emacsVisual"),
570 sizeof (".privateColormap"));
571 char *buf1 = alloca_array (char, strlen (app_name) + resource_name_length);
572 char *buf2 = alloca_array (char, strlen (app_class) + resource_name_length);
576 sprintf (buf1, "%s.emacsVisual", app_name);
577 sprintf (buf2, "%s.EmacsVisual", app_class);
578 if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)
581 int vis_class = PseudoColor;
583 char *str = (char*) value.addr;
585 #define CHECK_VIS_CLASS(visual_class) \
586 else if (memcmp (str, #visual_class, sizeof (#visual_class) - 1) == 0) \
587 cnt = sizeof (#visual_class) - 1, vis_class = visual_class
591 CHECK_VIS_CLASS (StaticGray);
592 CHECK_VIS_CLASS (StaticColor);
593 CHECK_VIS_CLASS (TrueColor);
594 CHECK_VIS_CLASS (GrayScale);
595 CHECK_VIS_CLASS (PseudoColor);
596 CHECK_VIS_CLASS (DirectColor);
600 depth = atoi (str + cnt);
603 stderr_out ("Invalid Depth specification in %s... ignoring...\n", str);
607 if (XMatchVisualInfo (dpy, screen, depth, vis_class, &vinfo))
609 visual = vinfo.visual;
613 stderr_out ("Can't match the requested visual %s... using defaults\n", str);
619 stderr_out( "Invalid Visual specification in %s... ignoring.\n", str);
625 visual = DefaultVisual(dpy, screen);
626 depth = DefaultDepth(dpy, screen);
628 visual = x_try_best_visual (dpy, screen);
629 depth = x_get_visual_depth (dpy, visual);
630 best_visual_found = (visual != DefaultVisual (dpy, screen));
633 /* If we've got the same visual as the default and it's PseudoColor,
634 check to see if the user specified that we need a private colormap */
635 if (visual == DefaultVisual (dpy, screen))
637 sprintf (buf1, "%s.privateColormap", app_name);
638 sprintf (buf2, "%s.PrivateColormap", app_class);
639 if ((visual->class == PseudoColor) &&
640 (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True))
642 cmap = XCopyColormapAndFree (dpy, DefaultColormap (dpy, screen));
646 cmap = DefaultColormap (dpy, screen);
651 if ( best_visual_found )
653 cmap = XCreateColormap (dpy, RootWindow (dpy, screen), visual, AllocNone);
657 /* We have to create a matching colormap anyway...
658 ### think about using standard colormaps (need the Xmu libs?) */
659 cmap = XCreateColormap(dpy, RootWindow(dpy, screen), visual, AllocNone);
660 XInstallColormap(dpy, cmap);
665 DEVICE_X_VISUAL (d) = visual;
666 DEVICE_X_COLORMAP (d) = cmap;
667 DEVICE_X_DEPTH (d) = depth;
668 validify_resource_component ((char *) XSTRING_DATA (DEVICE_NAME (d)),
669 XSTRING_LENGTH (DEVICE_NAME (d)));
673 XtSetArg (al[0], XtNvisual, visual);
674 XtSetArg (al[1], XtNdepth, depth);
675 XtSetArg (al[2], XtNcolormap, cmap);
677 app_shell = XtAppCreateShell (NULL, app_class,
678 applicationShellWidgetClass,
679 dpy, al, countof (al));
682 DEVICE_XT_APP_SHELL (d) = app_shell;
686 #endif /* HAVE_XIM */
688 /* Realize the app_shell so that its window exists for GC creation purposes,
689 and set it to the size of the root window for child placement purposes */
692 XtSetArg (al[0], XtNmappedWhenManaged, False);
693 XtSetArg (al[1], XtNx, 0);
694 XtSetArg (al[2], XtNy, 0);
695 XtSetArg (al[3], XtNwidth, WidthOfScreen (ScreenOfDisplay (dpy, screen)));
696 XtSetArg (al[4], XtNheight, HeightOfScreen (ScreenOfDisplay (dpy, screen)));
697 XtSetValues (app_shell, al, countof (al));
698 XtRealizeWidget (app_shell);
701 #ifdef HAVE_WMCOMMAND
705 make_argc_argv (Vcommand_line_args, &new_argc, &new_argv);
706 XSetCommand (XtDisplay (app_shell), XtWindow (app_shell), new_argv, new_argc);
707 free_argc_argv (new_argv);
709 #endif /* HAVE_WMCOMMAND */
712 #ifdef HAVE_OFFIX_DND
713 DndInitialize ( app_shell );
716 Vx_initial_argv_list = make_arg_list (argc, argv);
717 free_argc_argv (argv);
719 DEVICE_X_WM_COMMAND_FRAME (d) = Qnil;
721 sanity_check_geometry_resource (dpy);
724 x_init_modifier_mapping (d);
726 DEVICE_INFD (d) = DEVICE_OUTFD (d) = ConnectionNumber (dpy);
730 DEVICE_X_GC_CACHE (d) = make_gc_cache (dpy, XtWindow(app_shell));
731 DEVICE_X_GRAY_PIXMAP (d) = None;
732 Xatoms_of_device_x (d);
733 Xatoms_of_xselect (d);
734 Xatoms_of_objects_x (d);
735 x_init_device_class (d);
737 /* Run the elisp side of the X device initialization. */
738 call0 (Qinit_pre_x_win);
742 x_finish_init_device (struct device *d, Lisp_Object props)
744 call0 (Qinit_post_x_win);
748 x_mark_device (struct device *d)
750 mark_object (DEVICE_X_WM_COMMAND_FRAME (d));
751 mark_object (DEVICE_X_DATA (d)->x_keysym_map_hash_table);
755 /************************************************************************/
756 /* closing an X connection */
757 /************************************************************************/
760 free_x_device_struct (struct device *d)
762 xfree (d->device_data);
766 x_delete_device (struct device *d)
771 extern void (*__free_hook) (void *);
775 XSETDEVICE (device, d);
776 display = DEVICE_X_DISPLAY (d);
781 checking_free = (__free_hook != 0);
783 /* Disable strict free checking, to avoid bug in X library */
785 disable_strict_free_check ();
788 free_gc_cache (DEVICE_X_GC_CACHE (d));
789 if (DEVICE_X_DATA (d)->x_modifier_keymap)
790 XFreeModifiermap (DEVICE_X_DATA (d)->x_modifier_keymap);
791 if (DEVICE_X_DATA (d)->x_keysym_map)
792 XFree ((char *) DEVICE_X_DATA (d)->x_keysym_map);
794 if (DEVICE_XT_APP_SHELL (d))
796 XtDestroyWidget (DEVICE_XT_APP_SHELL (d));
797 DEVICE_XT_APP_SHELL (d) = NULL;
800 XtCloseDisplay (display);
801 DEVICE_X_DISPLAY (d) = 0;
804 enable_strict_free_check ();
808 if (EQ (device, Vdefault_x_device))
810 Lisp_Object devcons, concons;
811 /* #### handle deleting last X device */
812 Vdefault_x_device = Qnil;
813 DEVICE_LOOP_NO_BREAK (devcons, concons)
815 if (DEVICE_X_P (XDEVICE (XCAR (devcons))) &&
816 !EQ (device, XCAR (devcons)))
818 Vdefault_x_device = XCAR (devcons);
824 free_x_device_struct (d);
828 /************************************************************************/
829 /* handle X errors */
830 /************************************************************************/
833 x_event_name (int event_type)
835 static CONST char *events[] =
875 if (event_type < 0 || event_type >= countof (events))
877 return events [event_type];
882 If an X error occurs which we are not expecting, we have no alternative
883 but to print it to stderr. It would be nice to stuff it into a pop-up
884 buffer, or to print it in the minibuffer, but that's not possible, because
885 one is not allowed to do any I/O on the display connection from an error
886 handler. The guts of Xlib expect these functions to either return or exit.
888 However, there are occasions when we might expect an error to reasonably
889 occur. The interface to this is as follows:
891 Before calling some X routine which may error, call
892 expect_x_error (dpy);
894 Just after calling the X routine, call either:
896 x_error_occurred_p (dpy);
898 to ask whether an error happened (and was ignored), or:
900 signal_if_x_error (dpy, resumable_p);
902 which will call Fsignal() with args appropriate to the X error, if there
903 was one. (Resumable_p is whether the debugger should be allowed to
904 continue from the call to signal.)
906 You must call one of these two routines immediately after calling the X
907 routine; think of them as bookends like BLOCK_INPUT and UNBLOCK_INPUT.
910 static int error_expected;
911 static int error_occurred;
912 static XErrorEvent last_error;
916 #ifdef EXTERNAL_WIDGET
918 x_error_handler_do_enqueue (Lisp_Object frame)
920 enqueue_magic_eval_event (io_error_delete_frame, frame);
925 x_error_handler_error (Lisp_Object data, Lisp_Object dummy)
929 #endif /* EXTERNAL_WIDGET */
932 x_error_handler (Display *disp, XErrorEvent *event)
942 #ifdef EXTERNAL_WIDGET
944 struct device *d = get_device_from_display (disp);
946 if ((event->error_code == BadWindow ||
947 event->error_code == BadDrawable)
948 && ((f = x_any_window_to_frame (d, event->resourceid)) != 0))
952 /* one of the windows comprising one of our frames has died.
953 This occurs particularly with ExternalShell frames when the
954 client that owns the ExternalShell's window dies.
956 We cannot do any I/O on the display connection so we need
957 to enqueue an eval event so that the deletion happens
960 Furthermore, we need to trap any errors (out-of-memory) that
961 may occur when Fenqueue_eval_event is called.
964 if (f->being_deleted)
966 XSETFRAME (frame, f);
967 if (!NILP (condition_case_1 (Qerror, x_error_handler_do_enqueue,
968 frame, x_error_handler_error, Qnil)))
970 f->being_deleted = 1;
975 #endif /* EXTERNAL_WIDGET */
977 stderr_out ("\n%s: ",
978 (STRINGP (Vinvocation_name)
979 ? (char *) XSTRING_DATA (Vinvocation_name)
981 XmuPrintDefaultErrorMessage (disp, event, stderr);
987 expect_x_error (Display *dpy)
989 assert (!error_expected);
990 XSync (dpy, 0); /* handle pending errors before setting flag */
996 x_error_occurred_p (Display *dpy)
999 XSync (dpy, 0); /* handle pending errors before setting flag */
1000 val = error_occurred;
1007 signal_if_x_error (Display *dpy, int resumable_p)
1011 if (! x_error_occurred_p (dpy))
1014 sprintf (buf, "0x%X", (unsigned int) last_error.resourceid);
1015 data = Fcons (build_string (buf), data);
1018 sprintf (num, "%d", last_error.request_code);
1019 XGetErrorDatabaseText (last_error.display, "XRequest", num, "",
1022 sprintf (buf, "Request-%d", last_error.request_code);
1023 data = Fcons (build_string (buf), data);
1025 XGetErrorText (last_error.display, last_error.error_code, buf, sizeof (buf));
1026 data = Fcons (build_string (buf), data);
1028 Fsignal (Qx_error, data);
1029 if (! resumable_p) goto again;
1034 x_IO_error_handler (Display *disp)
1036 /* This function can GC */
1038 struct device *d = get_device_from_display_1 (disp);
1041 XSETDEVICE (dev, d);
1043 if (NILP (find_nonminibuffer_frame_not_on_device (dev)))
1045 /* We're going down. */
1047 ("\n%s: Fatal I/O Error %d (%s) on display connection \"%s\"\n",
1048 (STRINGP (Vinvocation_name) ?
1049 (char *) XSTRING_DATA (Vinvocation_name) : "xemacs"),
1050 errno, strerror (errno), DisplayString (disp));
1052 (" after %lu requests (%lu known processed) with %d events remaining.\n",
1053 NextRequest (disp) - 1, LastKnownRequestProcessed (disp),
1055 /* assert (!_Xdebug); */
1061 "I/O Error %d (%s) on display connection\n"
1062 " \"%s\" after after %lu requests (%lu known processed)\n"
1063 " with %d events remaining.\n"
1064 " Throwing to top level.\n",
1065 errno, strerror (errno), DisplayString (disp),
1066 NextRequest (disp) - 1, LastKnownRequestProcessed (disp),
1070 /* According to X specs, we should not return from this function, or
1071 Xlib might just decide to exit(). So we mark the offending
1072 console for deletion and throw to top level. */
1074 enqueue_magic_eval_event (io_error_delete_device, dev);
1075 DEVICE_X_BEING_DELETED (d) = 1;
1076 Fthrow (Qtop_level, Qnil);
1078 return 0; /* not reached */
1081 DEFUN ("x-debug-mode", Fx_debug_mode, 1, 2, 0, /*
1082 With a true arg, make the connection to the X server synchronous.
1083 With false, make it asynchronous. Synchronous connections are much slower,
1084 but are useful for debugging. (If you get X errors, make the connection
1085 synchronous, and use a debugger to set a breakpoint on `x_error_handler'.
1086 Your backtrace of the C stack will now be useful. In asynchronous mode,
1087 the stack above `x_error_handler' isn't helpful because of buffering.)
1088 If DEVICE is not specified, the selected device is assumed.
1090 Calling this function is the same as calling the C function `XSynchronize',
1091 or starting the program with the `-sync' command line argument.
1095 struct device *d = decode_x_device (device);
1097 XSynchronize (DEVICE_X_DISPLAY (d), !NILP (arg));
1100 message ("X connection is synchronous");
1102 message ("X connection is asynchronous");
1108 /************************************************************************/
1110 /************************************************************************/
1112 #if 0 /* bah humbug. The whole "widget == resource" stuff is such
1113 a crock of shit that I'm just going to ignore it all. */
1115 /* If widget is NULL, we are retrieving device or global face data. */
1118 construct_name_list (Display *display, Widget widget, char *fake_name,
1119 char *fake_class, char *name, char *class)
1121 char *stack [100][2];
1124 char *name_tail, *class_tail;
1128 for (this = widget; this; this = XtParent (this))
1130 stack [count][0] = this->core.name;
1131 stack [count][1] = XtClass (this)->core_class.class_name;
1136 else if (fake_name && fake_class)
1138 stack [count][0] = fake_name;
1139 stack [count][1] = fake_class;
1143 /* The root widget is an application shell; resource lookups use the
1144 specified application name and application class in preference to
1145 the name/class of that widget (which is argv[0] / "ApplicationShell").
1146 Generally the app name and class will be argv[0] / "Emacs" but
1147 the former can be set via the -name command-line option, and the
1148 latter can be set by changing `x-emacs-application-class' in
1151 XtGetApplicationNameAndClass (display,
1160 for (; count >= 0; count--)
1162 strcat (name_tail, stack [count][0]);
1163 for (; *name_tail; name_tail++)
1164 if (*name_tail == '.') *name_tail = '_';
1165 strcat (name_tail, ".");
1168 strcat (class_tail, stack [count][1]);
1169 for (; *class_tail; class_tail++)
1170 if (*class_tail == '.') *class_tail = '_';
1171 strcat (class_tail, ".");
1178 static char_dynarr *name_char_dynarr;
1179 static char_dynarr *class_char_dynarr;
1181 /* Given a locale and device specification from x-get-resource or
1182 x-get-resource-prefix, return the resource prefix and display to
1183 fetch the resource on. */
1186 x_get_resource_prefix (Lisp_Object locale, Lisp_Object device,
1187 Display **display_out, char_dynarr *name,
1192 if (NILP (Fvalid_specifier_locale_p (locale)))
1193 signal_simple_error ("Invalid locale", locale);
1194 if (WINDOWP (locale))
1195 /* #### I can't come up with any coherent way of naming windows.
1196 By relative position? That seems tricky because windows
1197 can change position, be split, etc. By order of creation?
1198 That seems less than useful. */
1199 signal_simple_error ("Windows currently can't be resourced", locale);
1201 if (!NILP (device) && !DEVICEP (device))
1202 CHECK_DEVICE (device);
1203 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device)))
1207 device = DFW_DEVICE (locale);
1208 if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device)))
1211 device = Vdefault_x_device;
1219 *display_out = DEVICE_X_DISPLAY (XDEVICE (device));
1222 char *appname, *appclass;
1223 int name_len, class_len;
1224 XtGetApplicationNameAndClass (*display_out, &appname, &appclass);
1225 name_len = strlen (appname);
1226 class_len = strlen (appclass);
1227 Dynarr_add_many (name , appname, name_len);
1228 Dynarr_add_many (class, appclass, class_len);
1229 validify_resource_component (Dynarr_atp (name, 0), name_len);
1230 validify_resource_component (Dynarr_atp (class, 0), class_len);
1233 if (EQ (locale, Qglobal))
1235 if (BUFFERP (locale))
1237 Dynarr_add_literal_string (name, ".buffer.");
1238 /* we know buffer is live; otherwise we got an error above. */
1239 Dynarr_add_validified_lisp_string (name, Fbuffer_name (locale));
1240 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsBuffer");
1242 else if (FRAMEP (locale))
1244 Dynarr_add_literal_string (name, ".frame.");
1245 /* we know frame is live; otherwise we got an error above. */
1246 Dynarr_add_validified_lisp_string (name, Fframe_name (locale));
1247 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsFrame");
1251 assert (DEVICEP (locale));
1252 Dynarr_add_literal_string (name, ".device.");
1253 /* we know device is live; otherwise we got an error above. */
1254 Dynarr_add_validified_lisp_string (name, Fdevice_name (locale));
1255 Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsDevice");
1260 DEFUN ("x-get-resource", Fx_get_resource, 3, 6, 0, /*
1261 Retrieve an X resource from the resource manager.
1263 The first arg is the name of the resource to retrieve, such as "font".
1264 The second arg is the class of the resource to retrieve, such as "Font".
1265 The third arg must be one of the symbols 'string, 'integer, 'natnum, or
1266 'boolean, specifying the type of object that the database is searched for.
1267 The fourth arg is the locale to search for the resources on, and can
1268 currently be a buffer, a frame, a device, or 'global. If omitted, it
1269 defaults to 'global.
1270 The fifth arg is the device to search for the resources on. (The resource
1271 database for a particular device is constructed by combining non-device-
1272 specific resources such as any command-line resources specified and any
1273 app-defaults files found [or the fallback resources supplied by XEmacs,
1274 if no app-defaults file is found] with device-specific resources such as
1275 those supplied using xrdb.) If omitted, it defaults to the device of
1276 LOCALE, if a device can be derived (i.e. if LOCALE is a frame or device),
1277 and otherwise defaults to the value of `default-x-device'.
1278 The sixth arg NOERROR, if non-nil, means do not signal an error if a
1279 bogus resource specification was retrieved (e.g. if a non-integer was
1280 given when an integer was requested). In this case, a warning is issued
1283 The resource names passed to this function are looked up relative to the
1286 If you want to search for a subresource, you just need to specify the
1287 resource levels in NAME and CLASS. For example, NAME could be
1288 "modeline.attributeFont", and CLASS "Face.AttributeFont".
1292 1) If LOCALE is a buffer, a call
1294 (x-get-resource "foreground" "Foreground" 'string SOME-BUFFER)
1296 is an interface to a C call something like
1298 XrmGetResource (db, "xemacs.buffer.BUFFER-NAME.foreground",
1299 "Emacs.EmacsLocaleType.EmacsBuffer.Foreground",
1302 2) If LOCALE is a frame, a call
1304 (x-get-resource "foreground" "Foreground" 'string SOME-FRAME)
1306 is an interface to a C call something like
1308 XrmGetResource (db, "xemacs.frame.FRAME-NAME.foreground",
1309 "Emacs.EmacsLocaleType.EmacsFrame.Foreground",
1312 3) If LOCALE is a device, a call
1314 (x-get-resource "foreground" "Foreground" 'string SOME-DEVICE)
1316 is an interface to a C call something like
1318 XrmGetResource (db, "xemacs.device.DEVICE-NAME.foreground",
1319 "Emacs.EmacsLocaleType.EmacsDevice.Foreground",
1322 4) If LOCALE is 'global, a call
1324 (x-get-resource "foreground" "Foreground" 'string 'global)
1326 is an interface to a C call something like
1328 XrmGetResource (db, "xemacs.foreground",
1332 Note that for 'global, no prefix is added other than that of the
1333 application itself; thus, you can use this locale to retrieve
1334 arbitrary application resources, if you really want to.
1336 The returned value of this function is nil if the queried resource is not
1337 found. If the third arg is `string', a string is returned, and if it is
1338 `integer', an integer is returned. If the third arg is `boolean', then the
1339 returned value is the list (t) for true, (nil) for false, and is nil to
1340 mean ``unspecified''.
1342 (name, class, type, locale, device, no_error))
1344 char* name_string, *class_string;
1348 Error_behavior errb = decode_error_behavior_flag (no_error);
1350 CHECK_STRING (name);
1351 CHECK_STRING (class);
1352 CHECK_SYMBOL (type);
1354 Dynarr_reset (name_char_dynarr);
1355 Dynarr_reset (class_char_dynarr);
1357 x_get_resource_prefix (locale, device, &display,
1358 name_char_dynarr, class_char_dynarr);
1362 db = XtDatabase (display);
1364 Dynarr_add (name_char_dynarr, '.');
1365 Dynarr_add_lisp_string (name_char_dynarr, name);
1366 Dynarr_add (class_char_dynarr, '.');
1367 Dynarr_add_lisp_string (class_char_dynarr, class);
1368 Dynarr_add (name_char_dynarr, '\0');
1369 Dynarr_add (class_char_dynarr, '\0');
1371 name_string = Dynarr_atp (name_char_dynarr, 0);
1372 class_string = Dynarr_atp (class_char_dynarr, 0);
1376 XrmName namelist[100];
1377 XrmClass classlist[100];
1378 XrmName *namerest = namelist;
1379 XrmClass *classrest = classlist;
1380 XrmRepresentation xrm_type;
1381 XrmRepresentation string_quark;
1383 XrmStringToNameList (name_string, namelist);
1384 XrmStringToClassList (class_string, classlist);
1385 string_quark = XrmStringToQuark ("String");
1387 /* ensure that they have the same length */
1388 while (namerest[0] && classrest[0])
1389 namerest++, classrest++;
1390 if (namerest[0] || classrest[0])
1391 signal_simple_error_2
1392 ("class list and name list must be the same length", name, class);
1393 result = XrmQGetResource (db, namelist, classlist, &xrm_type, &xrm_value);
1395 if (result != True || xrm_type != string_quark)
1397 raw_result = (char *) xrm_value.addr;
1400 if (EQ (type, Qstring))
1401 return build_string (raw_result);
1402 else if (EQ (type, Qboolean))
1404 if (!strcasecmp (raw_result, "off") ||
1405 !strcasecmp (raw_result, "false") ||
1406 !strcasecmp (raw_result, "no"))
1407 return Fcons (Qnil, Qnil);
1408 if (!strcasecmp (raw_result, "on") ||
1409 !strcasecmp (raw_result, "true") ||
1410 !strcasecmp (raw_result, "yes"))
1411 return Fcons (Qt, Qnil);
1412 return maybe_continuable_error
1414 "can't convert %s: %s to a Boolean", name_string, raw_result);
1416 else if (EQ (type, Qinteger) || EQ (type, Qnatnum))
1420 if (1 != sscanf (raw_result, "%d%c", &i, &c))
1421 return maybe_continuable_error
1423 "can't convert %s: %s to an integer", name_string, raw_result);
1424 else if (EQ (type, Qnatnum) && i < 0)
1425 return maybe_continuable_error
1427 "invalid numerical value %d for resource %s", i, name_string);
1429 return make_int (i);
1433 return maybe_signal_continuable_error
1434 (Qwrong_type_argument,
1435 list2 (build_translated_string
1436 ("should be string, integer, natnum or boolean"),
1442 DEFUN ("x-get-resource-prefix", Fx_get_resource_prefix, 1, 2, 0, /*
1443 Return the resource prefix for LOCALE on DEVICE.
1444 The resource prefix is the strings used to prefix resources if
1445 the LOCALE and DEVICE arguments were passed to `x-get-resource'.
1446 The returned value is a cons of a name prefix and a class prefix.
1447 For example, if LOCALE is a frame, the returned value might be
1448 \("xemacs.frame.FRAME-NAME" . "Emacs.EmacsLocaleType.EmacsFrame").
1449 If no valid X device for resourcing can be obtained, this function
1450 returns nil. (In such a case, `x-get-resource' would always return nil.)
1456 Dynarr_reset (name_char_dynarr );
1457 Dynarr_reset (class_char_dynarr);
1459 x_get_resource_prefix (locale, device, &display,
1460 name_char_dynarr, class_char_dynarr);
1464 return Fcons (make_string ((Bufbyte *) Dynarr_atp (name_char_dynarr, 0),
1465 Dynarr_length (name_char_dynarr)),
1466 make_string ((Bufbyte *) Dynarr_atp (class_char_dynarr, 0),
1467 Dynarr_length (class_char_dynarr)));
1470 DEFUN ("x-put-resource", Fx_put_resource, 1, 2, 0, /*
1471 Add a resource to the resource database for DEVICE.
1472 RESOURCE-LINE specifies the resource to add and should be a
1473 standard resource specification.
1475 (resource_line, device))
1477 struct device *d = decode_device (device);
1478 char *str, *colon_pos;
1480 CHECK_STRING (resource_line);
1481 str = (char *) XSTRING_DATA (resource_line);
1482 if (!(colon_pos = strchr (str, ':')) || strchr (str, '\n'))
1484 signal_simple_error ("Invalid resource line", resource_line);
1486 /* Only the following chars are allowed before the colon */
1487 " \t.*?abcdefghijklmnopqrstuvwxyz"
1488 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-")
1489 != (size_t) (colon_pos - str))
1494 XrmDatabase db = XtDatabase (DEVICE_X_DISPLAY (d));
1495 XrmPutLineResource (&db, str);
1502 /************************************************************************/
1503 /* display information functions */
1504 /************************************************************************/
1506 DEFUN ("default-x-device", Fdefault_x_device, 0, 0, 0, /*
1507 Return the default X device for resourcing.
1508 This is the first-created X device that still exists.
1512 return Vdefault_x_device;
1515 DEFUN ("x-display-visual-class", Fx_display_visual_class, 0, 1, 0, /*
1516 Return the visual class of the X display DEVICE is using.
1517 This can be altered from the default at startup using the XResource "EmacsVisual".
1518 The returned value will be one of the symbols `static-gray', `gray-scale',
1519 `static-color', `pseudo-color', `true-color', or `direct-color'.
1523 Visual *vis = DEVICE_X_VISUAL (decode_x_device (device));
1526 case StaticGray: return intern ("static-gray");
1527 case GrayScale: return intern ("gray-scale");
1528 case StaticColor: return intern ("static-color");
1529 case PseudoColor: return intern ("pseudo-color");
1530 case TrueColor: return intern ("true-color");
1531 case DirectColor: return intern ("direct-color");
1533 error ("display has an unknown visual class");
1534 return Qnil; /* suppress compiler warning */
1538 DEFUN ("x-display-visual-depth", Fx_display_visual_depth, 0, 1, 0, /*
1539 Return the bitplane depth of the visual the X display DEVICE is using.
1543 return make_int (DEVICE_X_DEPTH (decode_x_device (device)));
1547 x_device_system_metrics (struct device *d,
1548 enum device_metrics m)
1550 Display *dpy = DEVICE_X_DISPLAY (d);
1554 case DM_size_device:
1555 return Fcons (make_int (DisplayWidth (dpy, DefaultScreen (dpy))),
1556 make_int (DisplayHeight (dpy, DefaultScreen (dpy))));
1557 case DM_size_device_mm:
1558 return Fcons (make_int (DisplayWidthMM (dpy, DefaultScreen (dpy))),
1559 make_int (DisplayHeightMM (dpy, DefaultScreen (dpy))));
1560 case DM_num_bit_planes:
1561 return make_int (DisplayPlanes (dpy, DefaultScreen (dpy)));
1562 case DM_num_color_cells:
1563 return make_int (DisplayCells (dpy, DefaultScreen (dpy)));
1564 default: /* No such device metric property for X devices */
1569 DEFUN ("x-server-vendor", Fx_server_vendor, 0, 1, 0, /*
1570 Return the vendor ID string of the X server DEVICE is on.
1571 Return the empty string if the vendor ID string cannot be determined.
1575 Display *dpy = get_x_display (device);
1576 char *vendor = ServerVendor (dpy);
1578 return build_string (vendor ? vendor : "");
1581 DEFUN ("x-server-version", Fx_server_version, 0, 1, 0, /*
1582 Return the version numbers of the X server DEVICE is on.
1583 The returned value is a list of three integers: the major and minor
1584 version numbers of the X Protocol in use, and the vendor-specific release
1585 number. See also `x-server-vendor'.
1589 Display *dpy = get_x_display (device);
1591 return list3 (make_int (ProtocolVersion (dpy)),
1592 make_int (ProtocolRevision (dpy)),
1593 make_int (VendorRelease (dpy)));
1596 DEFUN ("x-valid-keysym-name-p", Fx_valid_keysym_name_p, 1, 1, 0, /*
1597 Return true if KEYSYM names a keysym that the X library knows about.
1598 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1599 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1603 CONST char *keysym_ext;
1605 CHECK_STRING (keysym);
1606 GET_C_STRING_CTEXT_DATA_ALLOCA (keysym, keysym_ext);
1608 return XStringToKeysym (keysym_ext) ? Qt : Qnil;
1611 DEFUN ("x-keysym-hash-table", Fx_keysym_hash_table, 0, 1, 0, /*
1612 Return a hash table which contains a hash key for all keysyms which
1613 name keys on the keyboard. See `x-keysym-on-keyboard-p'.
1617 struct device *d = decode_device (device);
1618 if (!DEVICE_X_P (d))
1619 signal_simple_error ("Not an X device", device);
1621 return DEVICE_X_DATA (d)->x_keysym_map_hash_table;
1624 DEFUN ("x-keysym-on-keyboard-sans-modifiers-p", Fx_keysym_on_keyboard_sans_modifiers_p,
1626 Return true if KEYSYM names a key on the keyboard of DEVICE.
1627 More precisely, return true if pressing a physical key
1628 on the keyboard of DEVICE without any modifier keys generates KEYSYM.
1629 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1630 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1631 The keysym name can be provided in two forms:
1632 - if keysym is a string, it must be the name as known to X windows.
1633 - if keysym is a symbol, it must be the name as known to XEmacs.
1634 The two names differ in capitalization and underscoring.
1638 struct device *d = decode_device (device);
1639 if (!DEVICE_X_P (d))
1640 signal_simple_error ("Not an X device", device);
1642 return (EQ (Qsans_modifiers,
1643 Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ?
1648 DEFUN ("x-keysym-on-keyboard-p", Fx_keysym_on_keyboard_p, 1, 2, 0, /*
1649 Return true if KEYSYM names a key on the keyboard of DEVICE.
1650 More precisely, return true if some keystroke (possibly including modifiers)
1651 on the keyboard of DEVICE keys generates KEYSYM.
1652 Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
1653 /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.
1654 The keysym name can be provided in two forms:
1655 - if keysym is a string, it must be the name as known to X windows.
1656 - if keysym is a symbol, it must be the name as known to XEmacs.
1657 The two names differ in capitalization and underscoring.
1661 struct device *d = decode_device (device);
1662 if (!DEVICE_X_P (d))
1663 signal_simple_error ("Not an X device", device);
1665 return (NILP (Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ?
1670 /************************************************************************/
1671 /* grabs and ungrabs */
1672 /************************************************************************/
1674 DEFUN ("x-grab-pointer", Fx_grab_pointer, 0, 3, 0, /*
1675 Grab the pointer and restrict it to its current window.
1676 If optional DEVICE argument is nil, the default device will be used.
1677 If optional CURSOR argument is non-nil, change the pointer shape to that
1678 until `x-ungrab-pointer' is called (it should be an object returned by the
1679 `make-cursor-glyph' function).
1680 If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all
1681 keyboard events during the grab.
1682 Returns t if the grab is successful, nil otherwise.
1684 (device, cursor, ignore_keyboard))
1687 int pointer_mode, result;
1688 struct device *d = decode_x_device (device);
1692 CHECK_POINTER_GLYPH (cursor);
1693 cursor = glyph_image_instance (cursor, device, ERROR_ME, 0);
1696 if (!NILP (ignore_keyboard))
1697 pointer_mode = GrabModeSync;
1699 pointer_mode = GrabModeAsync;
1701 w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d)));
1703 /* #### Possibly this needs to gcpro the cursor somehow, but it doesn't
1704 seem to cause a problem if XFreeCursor is called on a cursor in use
1705 in a grab; I suppose the X server counts the grab as a reference
1706 and doesn't free it until it exits? */
1707 result = XGrabPointer (DEVICE_X_DISPLAY (d), w,
1712 PointerMotionHintMask,
1713 GrabModeAsync, /* Keep pointer events flowing */
1714 pointer_mode, /* Stall keyboard events */
1715 w, /* Stay in this window */
1717 : XIMAGE_INSTANCE_X_CURSOR (cursor)),
1719 return (result == GrabSuccess) ? Qt : Qnil;
1722 DEFUN ("x-ungrab-pointer", Fx_ungrab_pointer, 0, 1, 0, /*
1723 Release a pointer grab made with `x-grab-pointer'.
1724 If optional first arg DEVICE is nil the default device is used.
1725 If it is t the pointer will be released on all X devices.
1729 if (!EQ (device, Qt))
1731 Display *dpy = get_x_display (device);
1732 XUngrabPointer (dpy, CurrentTime);
1736 Lisp_Object devcons, concons;
1738 DEVICE_LOOP_NO_BREAK (devcons, concons)
1740 struct device *d = XDEVICE (XCAR (devcons));
1743 XUngrabPointer (DEVICE_X_DISPLAY (d), CurrentTime);
1750 DEFUN ("x-grab-keyboard", Fx_grab_keyboard, 0, 1, 0, /*
1751 Grab the keyboard on the given device (defaulting to the selected one).
1752 So long as the keyboard is grabbed, all keyboard events will be delivered
1753 to emacs -- it is not possible for other X clients to eavesdrop on them.
1754 Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect).
1755 Returns t if the grab is successful, nil otherwise.
1759 struct device *d = decode_x_device (device);
1760 Window w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d)));
1761 Display *dpy = DEVICE_X_DISPLAY (d);
1764 status = XGrabKeyboard (dpy, w, True,
1765 /* I don't really understand sync-vs-async
1766 grabs, but this is what xterm does. */
1767 GrabModeAsync, GrabModeAsync,
1768 /* Use the timestamp of the last user action
1769 read by emacs proper; xterm uses CurrentTime
1770 but there's a comment that says "wrong"...
1771 (Despite the name this is the time of the
1772 last key or mouse event.) */
1773 DEVICE_X_MOUSE_TIMESTAMP (d));
1774 if (status == GrabSuccess)
1776 /* The XUngrabKeyboard should generate a FocusIn back to this
1777 window but it doesn't unless we explicitly set focus to the
1778 window first (which should already have it. The net result
1779 is that without this call when x-ungrab-keyboard is called
1780 the selected frame ends up not having focus. */
1781 XSetInputFocus (dpy, w, RevertToParent, DEVICE_X_MOUSE_TIMESTAMP (d));
1788 DEFUN ("x-ungrab-keyboard", Fx_ungrab_keyboard, 0, 1, 0, /*
1789 Release a keyboard grab made with `x-grab-keyboard'.
1793 Display *dpy = get_x_display (device);
1794 XUngrabKeyboard (dpy, CurrentTime);
1798 DEFUN ("x-get-font-path", Fx_get_font_path, 0, 1, 0, /*
1799 Get the X Server's font path.
1801 See also `x-set-font-path'.
1805 Display *dpy = get_x_display (device);
1807 CONST char **directories = (CONST char **) XGetFontPath (dpy, &ndirs_return);
1808 Lisp_Object font_path = Qnil;
1811 signal_simple_error ("Can't get X font path", device);
1813 while (ndirs_return--)
1814 font_path = Fcons (build_ext_string (directories[ndirs_return],
1815 FORMAT_FILENAME), font_path);
1820 DEFUN ("x-set-font-path", Fx_set_font_path, 1, 2, 0, /*
1821 Set the X Server's font path to FONT-PATH.
1823 There is only one font path per server, not one per client. Use this
1824 sparingly. It uncaches all of the X server's font information.
1826 Font directories should end in the path separator and should contain
1827 a file called fonts.dir usually created with the program mkfontdir.
1829 Setting the FONT-PATH to nil tells the X server to use the default
1832 See also `x-get-font-path'.
1834 (font_path, device))
1836 Display *dpy = get_x_display (device);
1837 Lisp_Object path_entry;
1838 CONST char **directories;
1841 EXTERNAL_LIST_LOOP (path_entry, font_path)
1843 CHECK_STRING (XCAR (path_entry));
1847 directories = alloca_array (CONST char *, ndirs);
1849 EXTERNAL_LIST_LOOP (path_entry, font_path)
1851 GET_C_STRING_FILENAME_DATA_ALLOCA (XCAR (path_entry), directories[i++]);
1854 expect_x_error (dpy);
1855 XSetFontPath (dpy, (char **) directories, ndirs);
1856 signal_if_x_error (dpy, 1/*resumable_p*/);
1862 /************************************************************************/
1863 /* initialization */
1864 /************************************************************************/
1867 syms_of_device_x (void)
1869 DEFSUBR (Fx_debug_mode);
1870 DEFSUBR (Fx_get_resource);
1871 DEFSUBR (Fx_get_resource_prefix);
1872 DEFSUBR (Fx_put_resource);
1874 DEFSUBR (Fdefault_x_device);
1875 DEFSUBR (Fx_display_visual_class);
1876 DEFSUBR (Fx_display_visual_depth);
1877 DEFSUBR (Fx_server_vendor);
1878 DEFSUBR (Fx_server_version);
1879 DEFSUBR (Fx_valid_keysym_name_p);
1880 DEFSUBR (Fx_keysym_hash_table);
1881 DEFSUBR (Fx_keysym_on_keyboard_p);
1882 DEFSUBR (Fx_keysym_on_keyboard_sans_modifiers_p);
1884 DEFSUBR (Fx_grab_pointer);
1885 DEFSUBR (Fx_ungrab_pointer);
1886 DEFSUBR (Fx_grab_keyboard);
1887 DEFSUBR (Fx_ungrab_keyboard);
1889 DEFSUBR (Fx_get_font_path);
1890 DEFSUBR (Fx_set_font_path);
1892 defsymbol (&Qx_error, "x-error");
1893 defsymbol (&Qinit_pre_x_win, "init-pre-x-win");
1894 defsymbol (&Qinit_post_x_win, "init-post-x-win");
1898 reinit_console_type_create_device_x (void)
1900 /* Initialize variables to speed up X resource interactions */
1901 CONST char *valid_resource_chars =
1902 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_";
1903 while (*valid_resource_chars)
1904 valid_resource_char_p[(unsigned int) (*valid_resource_chars++)] = 1;
1906 name_char_dynarr = Dynarr_new (char);
1907 class_char_dynarr = Dynarr_new (char);
1911 console_type_create_device_x (void)
1913 reinit_console_type_create_device_x ();
1914 CONSOLE_HAS_METHOD (x, init_device);
1915 CONSOLE_HAS_METHOD (x, finish_init_device);
1916 CONSOLE_HAS_METHOD (x, mark_device);
1917 CONSOLE_HAS_METHOD (x, delete_device);
1918 CONSOLE_HAS_METHOD (x, device_system_metrics);
1922 reinit_vars_of_device_x (void)
1927 in_resource_setting = 0;
1931 vars_of_device_x (void)
1933 reinit_vars_of_device_x ();
1935 DEFVAR_LISP ("x-emacs-application-class", &Vx_emacs_application_class /*
1936 The X application class of the XEmacs process.
1937 This controls, among other things, the name of the `app-defaults' file
1938 that XEmacs will use. For changes to this variable to take effect, they
1939 must be made before the connection to the X server is initialized, that is,
1940 this variable may only be changed before emacs is dumped, or by setting it
1941 in the file lisp/term/x-win.el.
1943 If this variable is nil before the connection to the X server is first
1944 initialized (which it is by default), the X resource database will be
1945 consulted and the value will be set according to whether any resources
1946 are found for the application class `XEmacs'. If the user has set any
1947 resources for the XEmacs application class, the XEmacs process will use
1948 the application class `XEmacs'. Otherwise, the XEmacs process will use
1949 the application class `Emacs' which is backwards compatible to previous
1950 XEmacs versions but may conflict with resources intended for GNU Emacs.
1952 Vx_emacs_application_class = Qnil;
1954 DEFVAR_LISP ("x-initial-argv-list", &Vx_initial_argv_list /*
1955 You don't want to know.
1956 This is used during startup to communicate the remaining arguments in
1957 `command-line-args-left' to the C code, which passes the args to
1958 the X initialization code, which removes some args, and then the
1959 args are placed back into `x-initial-arg-list' and thence into
1960 `command-line-args-left'. Perhaps `command-line-args-left' should
1963 Vx_initial_argv_list = Qnil;
1965 #if defined(MULE) && (defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET))
1966 DEFVAR_LISP ("x-app-defaults-directory", &Vx_app_defaults_directory /*
1967 Used by the Lisp code to communicate to the low level X initialization
1968 where the localized init files are.
1970 Vx_app_defaults_directory = Qnil;
1975 staticpro (&Vdefault_x_device);
1976 Vdefault_x_device = Qnil;