home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / src / device-x.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-08-18  |  43.0 KB  |  1,475 lines
  1. /* Device functions for X windows.
  2.    Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
  3.    Copyright (C) 1994, 1995 Amdahl Corporation.
  4.  
  5. This file is part of XEmacs.
  6.  
  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
  10. later version.
  11.  
  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
  15. for more details.
  16.  
  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 the Free
  19. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  20.  
  21. /* Synched up with: Not in FSF. */
  22.  
  23. /* Original authors: Jamie Zawinski and the FSF */
  24. /* Rewritten by Ben Wing and Chuck Thompson. */
  25.  
  26. #include <config.h>
  27. #include "lisp.h"
  28.  
  29. #include "device-x.h"
  30. #include "frame-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 XtVaGetValues(), but ... */
  35. #include "xgccache.h"
  36. #include <X11/Shell.h>
  37. #include "xmu.h"
  38. #include "glyphs-x.h"
  39. #include "objects-x.h"
  40.  
  41. #include "buffer.h"
  42. #include "events.h"
  43. #include "faces.h"
  44. #include "redisplay.h"
  45. #include "sysdep.h"
  46. #include "window.h"
  47.  
  48. #include "sysfile.h"
  49. #include "systime.h"
  50.  
  51. Lisp_Object Vdefault_x_device;
  52.  
  53. DEFINE_DEVICE_TYPE (x);
  54.  
  55. /* Qdisplay in general.c */
  56. Lisp_Object Qargv_list;
  57. Lisp_Object Qx_error;
  58.  
  59. /* The application class of Emacs. */
  60. Lisp_Object Vx_emacs_application_class;
  61.  
  62. static XrmOptionDescRec emacs_options[] = {
  63.   {"-geometry",    ".geometry", XrmoptionSepArg, NULL},
  64.   {"-iconic",    ".iconic", XrmoptionNoArg, (XtPointer) "yes"},
  65.  
  66.   {"-internal-border-width", "*EmacsFrame.internalBorderWidth",
  67.      XrmoptionSepArg, NULL},
  68.   {"-ib",    "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL},
  69.   {"-scrollbar-width", "*EmacsFrame.scrollBarWidth", XrmoptionSepArg, NULL},
  70.   {"-scrollbar-height", "*EmacsFrame.scrollBarHeight", XrmoptionSepArg, NULL},
  71.  
  72.   /* #### Beware!  If the type of the shell changes, update this. */
  73.   {"-T",    "*EmacsShell.title", XrmoptionSepArg, (XtPointer) NULL},
  74.   {"-wn",    "*EmacsShell.title", XrmoptionSepArg, (XtPointer) NULL},
  75.   {"-title",    "*EmacsShell.title", XrmoptionSepArg, (XtPointer) NULL},
  76.   {"-iconname",    "*EmacsShell.iconName", XrmoptionSepArg, (XtPointer) NULL},
  77.   {"-in",    "*EmacsShell.iconName", XrmoptionSepArg, (XtPointer) NULL},
  78.   {"-mc",    "*pointerColor", XrmoptionSepArg, (XtPointer) NULL},
  79.   {"-cr",    "*cursorColor", XrmoptionSepArg, (XtPointer) NULL}
  80. };
  81.  
  82. #ifdef I18N4
  83. extern void init_input (CONST char *res_name, CONST char *res_class,
  84.             Display *display);
  85. #endif
  86.  
  87. static void validify_resource_string (char *str);
  88.  
  89. /* Functions to synchronize mirroring resources and specifiers */
  90. int in_resource_setting;
  91. int in_specifier_change_function;
  92.  
  93.  
  94. /************************************************************************/
  95. /*                          helper functions                            */
  96. /************************************************************************/
  97.  
  98. struct device *
  99. get_device_from_display (Display *dpy)
  100. {
  101.   Lisp_Object dev;
  102.  
  103.   DEVICE_LOOP (dev)
  104.     {
  105.       struct device *d = XDEVICE (XCAR (dev));
  106.       if (DEVICE_IS_X (d) && DEVICE_X_DISPLAY (d) == dpy)
  107.     return d;
  108.     }
  109.  
  110.   /* Only devices we are actually managing should ever be used as an
  111.      argument to this function. */
  112.   abort ();
  113.  
  114.   return 0; /* suppress compiler warning */
  115. }
  116.  
  117. struct device *
  118. get_x_device (Lisp_Object device)
  119. {
  120.   if (NILP (device))
  121.     device = Fselected_device ();
  122.   /* quietly accept frames for the device arg */
  123.   if (FRAMEP (device))
  124.     device = XFRAME (device)->device;
  125.   CHECK_X_DEVICE (device, 0);
  126.   return XDEVICE (device);
  127. }
  128.  
  129. Display *
  130. get_x_display (Lisp_Object device)
  131. {
  132.   return DEVICE_X_DISPLAY (get_x_device (device));
  133. }
  134.  
  135.  
  136. /************************************************************************/
  137. /*              initializing an X connection            */
  138. /************************************************************************/
  139.  
  140. static void
  141. allocate_x_device_struct (struct device *d)
  142. {
  143.   d->device_data = (struct x_device *) xmalloc (sizeof (struct x_device));
  144.  
  145.   /* zero out all slots. */
  146.   memset (d->device_data, 0, sizeof (struct x_device));
  147. }
  148.  
  149. static void
  150. Xatoms_of_device_x (struct device *d)
  151. {
  152.   Display *display = DEVICE_X_DISPLAY (d);
  153. #define ATOM(x) XInternAtom (display, (x), False)
  154.  
  155.   DEVICE_XATOM_WM_PROTOCOLS (d) = ATOM ("WM_PROTOCOLS");
  156.   DEVICE_XATOM_WM_DELETE_WINDOW (d) = ATOM ("WM_DELETE_WINDOW");
  157.   DEVICE_XATOM_WM_SAVE_YOURSELF (d) = ATOM ("WM_SAVE_YOURSELF");
  158.   DEVICE_XATOM_WM_TAKE_FOCUS (d) = ATOM ("WM_TAKE_FOCUS");
  159.   DEVICE_XATOM_WM_STATE (d) = ATOM ("WM_STATE");
  160. }
  161.  
  162. static void
  163. sanity_check_geometry_resource (Display *dpy)
  164. {
  165.   char *app_name, *app_class, *s;
  166.   char buf1 [255], buf2 [255];
  167.   char *type;
  168.   XrmValue value;
  169.   XtGetApplicationNameAndClass (dpy, &app_name, &app_class);
  170.   strcpy (buf1, app_name);
  171.   strcpy (buf2, app_class);
  172.   for (s = buf1; *s; s++) if (*s == '.') *s = '_';
  173.   strcat (buf1, "._no_._such_._resource_.geometry");
  174.   strcat (buf2, "._no_._such_._resource_.Geometry");
  175.   if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)
  176.     {
  177.       warn_when_safe (Qgeometry, Qerror,
  178.               "\n\
  179. Apparently \"%s*geometry: %s\" or \"%s*geometry: %s\" was\n\
  180. specified in the resource database.  Specifying \"*geometry\" will make\n\
  181. XEmacs (and most other X programs) malfunction in obscure ways. (i.e.\n\
  182. the Xt or Xm libraries will probably crash, which is a very bad thing.)\n\
  183. You should always use \".geometry\" or \"*EmacsFrame.geometry\" instead.\n",
  184.           app_name, (char *) value.addr,
  185.           app_class, (char *) value.addr);
  186.       suppress_early_backtrace = 1;
  187.       error ("Invalid geometry resource");
  188.     }
  189. }
  190.  
  191. static void
  192. x_init_device_class (struct device *d)
  193. {
  194.   Display *dpy = DEVICE_X_DISPLAY (d);
  195.   if (DisplayCells (dpy, DefaultScreen (dpy)) > 2)
  196.     {
  197.       switch (DefaultVisualOfScreen (DefaultScreenOfDisplay (dpy))->class)
  198.     {
  199.     case StaticGray:
  200.     case GrayScale:
  201.       DEVICE_CLASS (d) = Qgrayscale;
  202.     default:
  203.       DEVICE_CLASS (d) = Qcolor;
  204.     }
  205.     }
  206.   else
  207.     DEVICE_CLASS (d) = Qmono;
  208. }
  209.  
  210. /* #### We either need to fix this to correctly handle multiple
  211.    connections to the same display (really fucking hard) or have it
  212.    return the already existing connection if one exists. */
  213.  
  214. static void
  215. x_init_device (struct device *d, Lisp_Object params)
  216. {
  217.   Lisp_Object display;
  218.   Lisp_Object argv_list;
  219.   Lisp_Object device;
  220.   Display *dpy;
  221.   int argc;
  222.   char *disp_name;
  223.   char **argv;
  224.   char *app_class;
  225.  
  226.   XSETDEVICE (device, d);
  227.   display = Fcdr_safe (Fassq (Qdisplay, params));
  228.   argv_list = Fcdr_safe (Fassq (Qargv_list, params));
  229.  
  230.   if (!NILP (display))
  231.     CHECK_STRING (display, 0);
  232.  
  233.   allocate_x_device_struct (d);
  234.  
  235.   if (NILP (Vdefault_x_device))
  236.     Vdefault_x_device = device;
  237.  
  238.   make_argc_argv (argv_list, &argc, &argv);
  239.  
  240.   /* no encapsulation of X functions: use string_ext_data() */
  241.  
  242.   if (STRINGP (Vx_emacs_application_class) &&
  243.       string_length (XSTRING (Vx_emacs_application_class)) > 0)
  244.     app_class = string_ext_data (XSTRING (Vx_emacs_application_class));
  245.   else
  246.     app_class = "Emacs";
  247.  
  248.   if (NILP (display))
  249.     {
  250.       /* If the user didn't explicitly specifify a display to use when
  251.          they called make-x-device, then we first check to see if a
  252.          display was specified on the command line with -display.  If
  253.          so, we set disp_name to it.  Otherwise we use XDisplayName to
  254.          see what DISPLAY is set to.  XtOpenDisplay knows how to do
  255.          both of these things, but we want to know the name to use in
  256.          the error message if XtOpenDisplay fails. */
  257.       if (display_arg)
  258.     {
  259.       int elt;
  260.  
  261.       disp_name = NULL;
  262.       for (elt = 0; elt < argc; elt++)
  263.         {
  264.           if (!strcmp (argv[elt], "-d") || !strcmp (argv[elt], "-display"))
  265.         {
  266.           if (elt + 1 == argc)
  267.             {
  268.               suppress_early_backtrace = 1;
  269.               error ("-display specified with no arg");
  270.             }
  271.           else
  272.             {
  273.               disp_name = argv[elt + 1];
  274.               break;
  275.             }
  276.         }
  277.         }
  278.  
  279.       /* assert: display_arg is only set if we found the display
  280.              arg earlier so we can't fail to find it now. */
  281.       assert (disp_name != NULL);
  282.     }
  283.       else
  284.     disp_name = XDisplayName (0);
  285.     }
  286.   else
  287.     disp_name = string_ext_data2 (XSTRING (display));
  288.  
  289.   slow_down_interrupts ();
  290.   /* The Xt code can't deal with signals here.  Yuck. */
  291.   dpy = DEVICE_X_DISPLAY (d) = XtOpenDisplay (Xt_app_con, disp_name, NULL,
  292.                           app_class, emacs_options,
  293.                           XtNumber (emacs_options),
  294.                           &argc, argv);
  295.   speed_up_interrupts ();
  296.  
  297.   if (dpy == 0)
  298.     {
  299.       suppress_early_backtrace = 1;
  300.       error ("X server \"%s\" not responding\n", disp_name);
  301.     }
  302.  
  303.   if (NILP (DEVICE_NAME (d)))
  304.     DEVICE_NAME (d) = build_string (disp_name);
  305.   else
  306.     /* We're going to modify the string in-place, so be a nice XEmacs */
  307.     DEVICE_NAME (d) = Fcopy_sequence (DEVICE_NAME (d));
  308.   /* colons and periods can't appear in individual elements of resource
  309.      strings */
  310.   validify_resource_string ((char *) string_data (XSTRING (DEVICE_NAME (d))));
  311.   DEVICE_XT_APP_SHELL (d) = XtAppCreateShell (NULL, app_class,
  312.                           applicationShellWidgetClass,
  313.                           dpy, NULL, 0);
  314.  
  315.   DEVICE_X_DATA (d)->display_name = xstrdup (disp_name);
  316.  
  317. #ifdef I18N4
  318.   init_input (*argv, app_class, dpy);
  319. #endif
  320.  
  321.   DEVICE_X_DATA (d)->argv_list = make_arg_list (argc, argv);
  322.   free_argc_argv (argv);
  323.  
  324.   DEVICE_X_WM_COMMAND_FRAME (d) = Qnil;
  325.  
  326.   sanity_check_geometry_resource (dpy);
  327.  
  328.   /* In event-Xt.c */
  329.   x_init_modifier_mapping (d);
  330.  
  331.   DEVICE_INFD (d) = DEVICE_OUTFD (d) = ConnectionNumber (dpy);
  332.   init_baud_rate (d);
  333.   init_one_device (d);
  334.  
  335.   DEVICE_X_GC_CACHE (d) =
  336.     make_gc_cache (dpy, RootWindow (dpy, DefaultScreen (dpy)));
  337.   DEVICE_X_GRAY_PIXMAP (d) = None;
  338.   Xatoms_of_device_x (d);
  339.   Xatoms_of_xselect (d);
  340.   Xatoms_of_objects_x (d);
  341.   x_init_device_class (d);
  342.  
  343.   /* This will cause the elisp side of the X device intialization to
  344.      be loaded.  At this point we consider the two parts to be one.
  345.      They are split up because of requirements in lisp/prim/startup.el */
  346.   Frequire (intern ("pre-x-win"), Qnil);
  347.   Frequire (intern ("post-x-win"), Qnil);
  348. }
  349.  
  350. static void
  351. x_mark_device (struct device *d, void (*markobj) (Lisp_Object))
  352. {
  353.   ((markobj) (DEVICE_X_DATA (d)->argv_list));
  354.   ((markobj) (DEVICE_X_DATA (d)->WM_COMMAND_frame));
  355. }
  356.  
  357. static int
  358. x_initially_selected_for_input (struct device *d)
  359. {
  360.   return 1;
  361. }
  362.  
  363.  
  364. /************************************************************************/
  365. /*                       closing an X connection                    */
  366. /************************************************************************/
  367.  
  368. static void
  369. free_x_device_struct (struct device *d)
  370. {
  371.   struct x_device *x_data = DEVICE_X_DATA (d);
  372.  
  373.   if (x_data->display_name)
  374.     xfree (x_data->display_name);
  375.   xfree (d->device_data);
  376. }
  377.  
  378. static void
  379. x_delete_device (struct device *d)
  380. {
  381.   Lisp_Object rest, device;
  382.   Display *display;
  383. #ifdef FREE_CHECKING
  384.   extern void (*__free_hook)();
  385.   int checking_free;
  386. #endif
  387.  
  388.   XSETDEVICE (device, d);
  389.   display = DEVICE_X_DISPLAY (d);
  390.  
  391.   if (display)
  392.     {
  393. #ifdef FREE_CHECKING
  394.       checking_free = (__free_hook != 0);
  395.       
  396.       /* Disable strict free checking, to avoid bug in X library */
  397.       if (checking_free)
  398.     disable_strict_free_check ();
  399. #endif
  400.  
  401.       free_gc_cache (DEVICE_X_GC_CACHE (d));
  402.       if (DEVICE_X_DATA (d)->x_modifier_keymap)
  403.     XFreeModifiermap (DEVICE_X_DATA (d)->x_modifier_keymap);
  404.       if (DEVICE_X_DATA (d)->x_keysym_map)
  405.     XFree ((char *) DEVICE_X_DATA (d)->x_keysym_map);
  406.  
  407.       XtCloseDisplay (display);
  408.       DEVICE_X_DISPLAY (d) = 0;
  409. #ifdef FREE_CHECKING
  410.       if (checking_free)
  411.     enable_strict_free_check ();
  412. #endif
  413.     }
  414.   
  415.   if (EQ (device, Vdefault_x_device))
  416.     {
  417.       /* #### handle deleting last X device */
  418.       Vdefault_x_device = Qnil;
  419.       DEVICE_LOOP (rest)
  420.     {
  421.       if (DEVICE_IS_X (XDEVICE (XCAR (rest))))
  422.         {
  423.           Vdefault_x_device = XCAR (rest);
  424.           break;
  425.         }
  426.     }
  427.     }
  428.   free_x_device_struct (d);
  429. }
  430.  
  431.  
  432. /************************************************************************/
  433. /*                handle X errors                */
  434. /************************************************************************/
  435.  
  436. static CONST char *events[] =
  437. {
  438.    "0: ERROR!",
  439.    "1: REPLY",
  440.    "KeyPress",
  441.    "KeyRelease",
  442.    "ButtonPress",
  443.    "ButtonRelease",
  444.    "MotionNotify",
  445.    "EnterNotify",
  446.    "LeaveNotify",
  447.    "FocusIn",
  448.    "FocusOut",
  449.    "KeymapNotify",
  450.    "Expose",
  451.    "GraphicsExpose",
  452.    "NoExpose",
  453.    "VisibilityNotify",
  454.    "CreateNotify",
  455.    "DestroyNotify",
  456.    "UnmapNotify",
  457.    "MapNotify",
  458.    "MapRequest",
  459.    "ReparentNotify",
  460.    "ConfigureNotify",
  461.    "ConfigureRequest",
  462.    "GravityNotify",
  463.    "ResizeRequest",
  464.    "CirculateNotify",
  465.    "CirculateRequest",
  466.    "PropertyNotify",
  467.    "SelectionClear",
  468.    "SelectionRequest",
  469.    "SelectionNotify",
  470.    "ColormapNotify",
  471.    "ClientMessage",
  472.    "MappingNotify",
  473.    "LASTEvent"
  474. };
  475.  
  476. CONST char *
  477. x_event_name (int event_type)
  478. {
  479.   if (event_type < 0) return 0;
  480.   if (event_type >= (sizeof (events) / sizeof (char *))) return 0;
  481.   return events [event_type];
  482. }
  483.  
  484. /* Handling errors.
  485.  
  486.    If an X error occurs which we are not expecting, we have no alternative
  487.    but to print it to stderr.  It would be nice to stuff it into a pop-up
  488.    buffer, or to print it in the minibuffer, but that's not possible, because
  489.    one is not allowed to do any I/O on the display connection from an error
  490.    handler. The guts of Xlib expect these functions to either return or exit.
  491.  
  492.    However, there are occasions when we might expect an error to reasonably
  493.    occur.  The interface to this is as follows:
  494.  
  495.    Before calling some X routine which may error, call
  496.     expect_x_error (dpy);
  497.  
  498.    Just after calling the X routine, call either:
  499.  
  500.     x_error_occurred_p (dpy);
  501.  
  502.    to ask whether an error happened (and was ignored), or:
  503.  
  504.     signal_if_x_error (dpy, resumable_p);
  505.  
  506.    which will call Fsignal() with args appropriate to the X error, if there
  507.    was one.  (Resumable_p is whether the debugger should be allowed to
  508.    continue from the call to signal.)
  509.  
  510.    You must call one of these two routines immediately after calling the X
  511.    routine; think of them as bookends like BLOCK_INPUT and UNBLOCK_INPUT.
  512.  */
  513.  
  514. static int error_expected;
  515. static int error_occurred;
  516. static XErrorEvent last_error;
  517.  
  518. extern Lisp_Object Qdelete_frame;
  519.  
  520. /* OVERKILL! */
  521.  
  522. #ifdef EXTERNAL_WIDGET
  523. static Lisp_Object
  524. x_error_handler_do_enqueue (Lisp_Object frame)
  525. {
  526.   Fenqueue_eval_event (Qdelete_frame, frame);
  527.   return Qt;
  528. }
  529.  
  530. static Lisp_Object
  531. x_error_handler_error (Lisp_Object data, Lisp_Object dummy)
  532. {
  533.   return Qnil;
  534. }
  535. #endif /* EXTERNAL_WIDGET */
  536.  
  537. int
  538. x_error_handler (Display *disp, XErrorEvent *event)
  539. {
  540.   if (error_expected)
  541.     {
  542.       error_expected = 0;
  543.       error_occurred = 1;
  544.       last_error = *event;
  545.     }
  546.   else
  547.     {
  548. #ifdef EXTERNAL_WIDGET
  549.       struct frame *f;
  550.       struct device *d = get_device_from_display (disp);
  551.  
  552.       if ((event->error_code == BadWindow ||
  553.        event->error_code == BadDrawable)
  554.       && ((f = x_any_window_to_frame (d, event->resourceid)) != 0))
  555.     {
  556.       Lisp_Object frame;
  557.  
  558.     /* one of the windows comprising one of our frames has died.
  559.        This occurs particularly with ExternalShell frames when the
  560.        client that owns the ExternalShell's window dies.
  561.  
  562.        We cannot do any I/O on the display connection so we need
  563.        to enqueue an eval event so that the deletion happens
  564.        later.
  565.  
  566.        Furthermore, we need to trap any errors (out-of-memory) that
  567.        may occur when Fenqueue_eval_event is called.
  568.      */
  569.  
  570.     if (f->being_deleted)
  571.       return 0;
  572.     XSETFRAME (frame, f);
  573.     if (!NILP (condition_case_1 (Qerror, x_error_handler_do_enqueue,
  574.                      frame, x_error_handler_error, Qnil)))
  575.       {
  576.         f->being_deleted = 1;
  577.         f->visible = 0;
  578.       }
  579.     return 0;
  580.       }
  581. #endif /* EXTERNAL_WIDGET */
  582.  
  583.       stderr_out ("\n%s: ",
  584.           (STRINGP (Vinvocation_name)
  585.            ? (char *) string_data (XSTRING (Vinvocation_name))
  586.            : "xemacs"));
  587.       XmuPrintDefaultErrorMessage (disp, event, stderr);
  588.     }
  589.   return 0;
  590. }
  591.  
  592. void
  593. expect_x_error (Display *dpy)
  594. {
  595.   assert (!error_expected);
  596.   XSync (dpy, 0);    /* handle pending errors before setting flag */
  597.   error_expected = 1;
  598.   error_occurred = 0;
  599. }
  600.  
  601. int
  602. x_error_occurred_p (Display *dpy)
  603. {
  604.   int val;
  605.   XSync (dpy, 0);    /* handle pending errors before setting flag */
  606.   val = error_occurred;
  607.   error_expected = 0;
  608.   error_occurred = 0;
  609.   return val;
  610. }
  611.  
  612. int
  613. signal_if_x_error (Display *dpy, int resumable_p)
  614. {
  615.   char buf[1024];
  616.   Lisp_Object data;
  617.   if (! x_error_occurred_p (dpy))
  618.     return 0;
  619.   data = Qnil;
  620.   sprintf (buf, "0x%X", (unsigned int) last_error.resourceid);
  621.   data = Fcons (build_string (buf), data);
  622.   {
  623.     char num [32];
  624.     sprintf (num, "%d", last_error.request_code);
  625.     XGetErrorDatabaseText (last_error.display, "XRequest", num, "",
  626.                buf, sizeof (buf));
  627.     if (! *buf)
  628.       sprintf (buf, "Request-%d", last_error.request_code);
  629.     data = Fcons (build_string (buf), data);
  630.   }
  631.   XGetErrorText (last_error.display, last_error.error_code, buf, sizeof (buf));
  632.   data = Fcons (build_string (buf), data);
  633.  again:
  634.   Fsignal (Qx_error, data);
  635.   if (! resumable_p) goto again;
  636.   return 1;
  637. }
  638.  
  639. int
  640. x_IO_error_handler (Display *disp)
  641. {
  642.   /* This function can GC */
  643.   Lisp_Object dev;
  644.   struct device *d = get_device_from_display (disp);
  645.  
  646.   if (XINT (Flength (Vdevice_list)) == 1)
  647.     {
  648.       stderr_out
  649.     ("\n%s: Fatal I/O Error %d (%s) on display connection \"%s\"\n",
  650.          (STRINGP (Vinvocation_name) ?
  651.       (char *) string_data (XSTRING (Vinvocation_name)) : "xemacs"),
  652.      errno, strerror (errno), DisplayString (disp));
  653.       stderr_out
  654.         ("  after %lu requests (%lu known processed) with %d events remaining.\n",
  655.          NextRequest (disp) - 1, LastKnownRequestProcessed (disp),
  656.          QLength (disp));
  657.       /* assert (!_Xdebug); */
  658.     }
  659.   else
  660.     {
  661.       warn_when_safe
  662.     (Qx, Qcritical,
  663.      "I/O Error %d (%s) on display connection \"%s\"\n"
  664.      "  after %lu requests (%lu known processed) with "
  665.      "%d events remaining.\n",
  666.      errno, strerror (errno), DisplayString (disp),
  667.          NextRequest (disp) - 1, LastKnownRequestProcessed (disp),
  668.          QLength (disp));
  669.     }
  670.  
  671.   XSETDEVICE (dev, d);
  672.   Fenqueue_eval_event (Qdelete_device, Fcons (Qunbound, dev));
  673.  
  674.   return 0;
  675. }
  676.  
  677. DEFUN ("x-debug-mode", Fx_debug_mode, Sx_debug_mode, 1, 2, 0,
  678.        "With a true arg, make the connection to the X server synchronous.\n\
  679. With false, make it asynchronous.  Synchronous connections are much slower,\n\
  680. but are useful for debugging. (If you get X errors, make the connection\n\
  681. synchronous, and use a debugger to set a breakpoint on `x_error_handler'.\n\
  682. Your backtrace of the C stack will now be useful.  In asynchronous mode,\n\
  683. the stack above `x_error_handler' isn't helpful because of buffering.)\n\
  684. If DEVICE is not specified, the selected device is assumed.\n\
  685. \n\
  686. Calling this function is the same as calling the C function `XSynchronize',\n\
  687. or starting the program with the `-sync' command line argument.")
  688.     (arg, device)
  689.     Lisp_Object arg, device;
  690. {
  691.   struct device *d = get_x_device (device);
  692.  
  693.   XSynchronize (DEVICE_X_DISPLAY (d), !NILP (arg));
  694.  
  695.   if (!NILP (arg))
  696.     message ("X connection is synchronous");
  697.   else
  698.     message ("X connection is asynchronous");
  699.  
  700.   return arg;
  701. }
  702.  
  703.  
  704. /************************************************************************/
  705. /*                             X resources                              */
  706. /************************************************************************/
  707.  
  708. #if 0 /* bah humbug.  The whole "widget == resource" stuff is such
  709.      a crock of shit that I'm just going to ignore it all. */
  710.  
  711. /* If widget is NULL, we are retrieving device or global face data. */
  712.  
  713. static void
  714. construct_name_list (Display *display, Widget widget, char *fake_name,
  715.              char *fake_class, char *name, char *class)
  716. {
  717.   char *stack [100][2];
  718.   Widget this;
  719.   int count = 0;
  720.   char *name_tail, *class_tail;
  721.  
  722.   if (widget)
  723.     {
  724.       for (this = widget; this; this = XtParent (this))
  725.     {
  726.       stack [count][0] = this->core.name;
  727.       stack [count][1] = XtClass (this)->core_class.class_name;
  728.       count++;
  729.     }
  730.       count--;
  731.     }
  732.   else if (fake_name && fake_class)
  733.     {
  734.       stack [count][0] = fake_name;
  735.       stack [count][1] = fake_class;
  736.       count++;
  737.     }
  738.  
  739.   /* The root widget is an application shell; resource lookups use the
  740.      specified application name and application class in preference to
  741.      the name/class of that widget (which is argv[0] / "ApplicationShell").
  742.      Generally the app name and class will be argv[0] / "Emacs" but
  743.      the former can be set via the -name command-line option, and the
  744.      latter can be set by changing `x-emacs-application-class' in
  745.      lisp/term/x-win.el.
  746.    */
  747.   XtGetApplicationNameAndClass (display,
  748.                 &stack [count][0],
  749.                 &stack [count][1]);
  750.  
  751.   name [0] = 0;
  752.   class [0] = 0;
  753.  
  754.   name_tail  = name;
  755.   class_tail = class;
  756.   for (; count >= 0; count--)
  757.     {
  758.       strcat (name_tail,  stack [count][0]);
  759.       for (; *name_tail; name_tail++)
  760.     if (*name_tail == '.') *name_tail = '_';
  761.       strcat (name_tail, ".");
  762.       name_tail++;
  763.  
  764.       strcat (class_tail, stack [count][1]);
  765.       for (; *class_tail; class_tail++)
  766.     if (*class_tail == '.') *class_tail = '_';
  767.       strcat (class_tail, ".");
  768.       class_tail++;
  769.     }
  770. }
  771.  
  772. #endif
  773.  
  774. /* Only the characters [-_A-Za-z0-9] are allowed in the individual
  775.    sections of a resource.  Convert invalid characters to -. */
  776.  
  777. static void
  778. validify_resource_string (char *str)
  779. {
  780.   while (*str)
  781.     {
  782.       if (!strchr ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  783.            "abcdefghijklmnopqrstuvwxyz"
  784.            "0123456789-_", *str))
  785.     *str = '-';
  786.       str++;
  787.     }
  788. }
  789.  
  790. /* Given a locale and device specification from x-get-resource or
  791. x-get-resource-prefix, return the resource prefix and display to
  792. fetch the resource on. */
  793.  
  794. static void
  795. x_get_resource_prefix (Lisp_Object locale, Lisp_Object device,
  796.                Display **display_out, char *name_out,
  797.                char *class_out)
  798. {
  799.   char *appname, *appclass;
  800.  
  801.   if (NILP (locale))
  802.     locale = Qglobal;
  803.   if (NILP (Fvalid_specifier_locale_p (locale)))
  804.     signal_simple_error ("Invalid locale", locale);
  805.   if (WINDOWP (locale))
  806.     /* #### I can't come up with any coherent way of naming windows.
  807.        By relative position?  That seems tricky because windows
  808.        can change position, be split, etc.  By order of creation?
  809.        That seems less than useful. */
  810.     signal_simple_error ("Windows currently can't be resourced", locale);
  811.  
  812.   if (!NILP (device) && !DEVICEP (device))
  813.     CHECK_DEVICE (device, 0);
  814.   if (DEVICEP (device) && !DEVICE_IS_X (XDEVICE (device)))
  815.     device = Qnil;
  816.   if (NILP (device))
  817.     {
  818.       device = DFW_DEVICE (locale);
  819.       if (DEVICEP (device) && !DEVICE_IS_X (XDEVICE (device)))
  820.     device = Qnil;
  821.       if (NILP (device))
  822.     device = Vdefault_x_device;
  823.       if (NILP (device))
  824.     {
  825.       *display_out = 0;
  826.       return;
  827.     }
  828.     }
  829.  
  830.   *display_out = DEVICE_X_DISPLAY (XDEVICE (device));
  831.  
  832.   XtGetApplicationNameAndClass (*display_out, &appname, &appclass);
  833.   strcpy (name_out, appname);
  834.   strcpy (class_out, appclass);
  835.   validify_resource_string (name_out);
  836.   validify_resource_string (class_out);
  837.  
  838.   if (EQ (locale, Qglobal))
  839.     return;
  840.   if (BUFFERP (locale))
  841.     {
  842.       strcat (name_out, ".buffer.");
  843.       /* we know buffer is live; otherwise we got an error above. */
  844.       strcat (name_out,
  845.           (CONST char *) string_data (XSTRING (Fbuffer_name (locale))));
  846.       strcat (class_out, ".EmacsLocaleType.EmacsBuffer");
  847.     }
  848.   else if (FRAMEP (locale))
  849.     {
  850.       strcat (name_out, ".frame.");
  851.       /* we know frame is live; otherwise we got an error above. */
  852.       strcat (name_out,
  853.           (CONST char *) string_data (XSTRING (Fframe_name (locale))));
  854.       strcat (class_out, ".EmacsLocaleType.EmacsFrame");
  855.     }
  856.   else
  857.     {
  858.       assert (DEVICEP (locale));
  859.       strcat (name_out, ".device.");
  860.       /* we know device is live; otherwise we got an error above. */
  861.       strcat (name_out,
  862.           (CONST char *) string_data (XSTRING (Fdevice_name (locale))));
  863.       strcat (class_out, ".EmacsLocaleType.EmacsDevice");
  864.     }
  865.   return;
  866. }
  867.  
  868. DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 3, 6, 0,
  869.        "Retrieve an X resource from the resource manager.\n\
  870. \n\
  871. The first arg is the name of the resource to retrieve, such as \"font\".\n\
  872. The second arg is the class of the resource to retrieve, like \"Font\".\n\
  873. The third arg should be one of the symbols 'string, 'integer, 'natnum, or\n\
  874.   'boolean, specifying the type of object that the database is searched for.\n\
  875. The fourth arg is the locale to search for the resources on, and can\n\
  876.   currently be a a buffer, a frame, a device, or 'global.  If omitted, it\n\
  877.   defaults to 'global.\n\
  878. The fifth arg is the device to search for the resources on. (The resource\n\
  879.   database for a particular device is constructed by combining non-device-\n\
  880.   specific resources such any command-line resources specified and any\n\
  881.   app-defaults files found [or the fallback resources supplied by XEmacs,\n\
  882.   if no app-defaults file is found] with device-specific resources such as\n\
  883.   those supplied using xrdb.) If omitted, it defaults to the device of\n\
  884.   LOCALE, if a device can be derived (i.e. if LOCALE is a frame or device),\n\
  885.   and otherwise defaults to the value of `default-x-device'.\n\
  886. The sixth arg NOERROR, if non-nil, means do not signal an error if a\n\
  887.   bogus resource specification was retrieved (e.g. if a non-integer was\n\
  888.   given when an integer was requested).  In this case, a warning is issued\n\
  889.   instead.\n\
  890. \n\
  891. The resource names passed to this function are looked up relative to the\n\
  892. locale.\n\
  893. \n\
  894. If you want to search for a subresource, you just need to specify the\n\
  895. resource levels in NAME and CLASS.  For example, NAME could be\n\
  896. \"modeline.attributeFont\", and CLASS \"Face.AttributeFont\".\n\
  897. \n\
  898. Specifically,\n\
  899. \n\
  900. 1) If LOCALE is a buffer, a call\n\
  901. \n\
  902.     (x-get-resource \"foreground\" \"Foreground\" 'string SOME-BUFFER)\n\
  903. \n\
  904. is an interface to a C call something like\n\
  905. \n\
  906.     XrmGetResource (db, \"xemacs.buffer.BUFFER-NAME.foreground\",\n\
  907.             \"Emacs.EmacsLocaleType.EmacsBuffer.Foreground\",\n\
  908.             \"String\");\n\
  909. \n\
  910. 2) If LOCALE is a frame, a call\n\
  911. \n\
  912.     (x-get-resource \"foreground\" \"Foreground\" 'string SOME-FRAME)\n\
  913. \n\
  914. is an interface to a C call something like\n\
  915. \n\
  916.     XrmGetResource (db, \"xemacs.frame.FRAME-NAME.foreground\",\n\
  917.             \"Emacs.EmacsLocaleType.EmacsFrame.Foreground\",\n\
  918.             \"String\");\n\
  919. \n\
  920. 3) If LOCALE is a device, a call\n\
  921. \n\
  922.     (x-get-resource \"foreground\" \"Foreground\" 'string SOME-DEVICE)\n\
  923. \n\
  924. is an interface to a C call something like\n\
  925. \n\
  926.     XrmGetResource (db, \"xemacs.device.DEVICE-NAME.foreground\",\n\
  927.             \"Emacs.EmacsLocaleType.EmacsDevice.Foreground\",\n\
  928.             \"String\");\n\
  929. \n\
  930. 4) If LOCALE is 'global, a call\n\
  931. \n\
  932.     (x-get-resource \"foreground\" \"Foreground\" 'string 'global)\n\
  933. \n\
  934. is an interface to a C call something like\n\
  935. \n\
  936.     XrmGetResource (db, \"xemacs.foreground\",\n\
  937.             \"Emacs.Foreground\",\n\
  938.             \"String\");\n\
  939. \n\
  940. Note that for 'global, no prefix is added other than that of the\n\
  941. application itself; thus, you can use this locale to retrieve\n\
  942. arbitrary application resources, if you really want to.\n\
  943. \n\
  944. The returned value of this function is nil if the queried resource is not\n\
  945. found.  If the third arg is `string', a string is returned, and if it is\n\
  946. `integer', an integer is returned.  If the third arg is `boolean', then the\n\
  947. returned value is the list (t) for true, (nil) for false, and is nil to\n\
  948. mean ``unspecified.''")
  949.      (name, class, type, locale, device, no_error)
  950.      Lisp_Object name, class, type, locale, device, no_error;
  951. {
  952.   /* #### fixed limit, could be overflowed */
  953.   char name_string[1024], class_string[1024];
  954.   char *raw_result;
  955.   XrmDatabase db;
  956.   Display *display;
  957.  
  958.   CHECK_STRING (name, 0);
  959.   CHECK_STRING (class, 0);
  960.   CHECK_SYMBOL (type, 0);
  961.  
  962.   if (!EQ (type, Qstring) && !EQ (type, Qboolean) &&
  963.       !EQ (type, Qinteger) && !EQ (type, Qnatnum))
  964.     return
  965.       Fsignal (Qwrong_type_argument,
  966.            list2 (build_translated_string
  967.               ("should be string, integer, natnum or boolean"),
  968.               type));
  969.  
  970.   x_get_resource_prefix (locale, device, &display, name_string,
  971.              class_string);
  972.   if (!display)
  973.     return Qnil;
  974.  
  975.   db = XtDatabase (display);
  976.  
  977.   strcat (name_string, ".");
  978.   strcat (name_string, (CONST char *) string_data (XSTRING (name)));
  979.   strcat (class_string, ".");
  980.   strcat (class_string, (CONST char *) string_data (XSTRING (class)));
  981.  
  982.   {
  983.     XrmValue xrm_value;
  984.     XrmName namelist[100];
  985.     XrmClass classlist[100];
  986.     XrmName *namerest = namelist;
  987.     XrmClass *classrest = classlist;
  988.     XrmRepresentation xrm_type;
  989.     XrmRepresentation string_quark;
  990.     int result;
  991.     XrmStringToNameList (name_string, namelist);
  992.     XrmStringToClassList (class_string, classlist);
  993.     string_quark = XrmStringToQuark ("String");
  994.  
  995.     /* ensure that they have the same length */
  996.     while (namerest[0] && classrest[0])
  997.       namerest++, classrest++;
  998.     if (namerest[0] || classrest[0])
  999.       signal_simple_error_2
  1000.     ("class list and name list must be the same length", name, class);
  1001.     result = XrmQGetResource (db, namelist, classlist, &xrm_type, &xrm_value);
  1002.  
  1003.     if (result != True || xrm_type != string_quark)
  1004.       return Qnil;
  1005.     raw_result = (char *) xrm_value.addr;
  1006.   }
  1007.  
  1008.   if (EQ (type, Qstring))
  1009.     return build_string (raw_result);
  1010.   else if (EQ (type, Qboolean))
  1011.     {
  1012.       if (!strcasecmp (raw_result, "off") ||
  1013.       !strcasecmp (raw_result, "false") ||
  1014.       !strcasecmp (raw_result,"no"))
  1015.     return Fcons (Qnil, Qnil);
  1016.       else if (!strcasecmp (raw_result, "on") ||
  1017.            !strcasecmp (raw_result, "true") ||
  1018.            !strcasecmp (raw_result, "yes"))
  1019.     return Fcons (Qt, Qnil);
  1020.       else
  1021.     {
  1022.       char str[1255];
  1023.       sprintf (str, "can't convert %s: %s to a Boolean",
  1024.            name_string, raw_result);
  1025.       if (!NILP (no_error))
  1026.         {
  1027.           warn_when_safe (Qresource, Qwarning, str);
  1028.           return Qnil;
  1029.         }
  1030.       else
  1031.         {
  1032.           return Fsignal (Qerror, list1 (build_string (str)));
  1033.         }
  1034.     }
  1035.     }
  1036.   else if (EQ (type, Qinteger) || EQ (type, Qnatnum))
  1037.     {
  1038.       int i;
  1039.       char c;
  1040.       if (1 != sscanf (raw_result, "%d%c", &i, &c))
  1041.     {
  1042.       char str[1255];
  1043.       sprintf (str, "can't convert %s: %s to an integer",
  1044.            name_string, raw_result);
  1045.       if (!NILP (no_error))
  1046.         {
  1047.           warn_when_safe (Qresource, Qwarning, str);
  1048.           return Qnil;
  1049.         }
  1050.       else
  1051.         {
  1052.           return Fsignal (Qerror, list1 (build_string (str)));
  1053.         }
  1054.     }
  1055.       else if (EQ (type, Qnatnum) && i < 0)
  1056.     {
  1057.       char str[1255];
  1058.       sprintf (str, "invalid numerical value %d for resource %s",
  1059.            i, name_string);
  1060.       if (!NILP (no_error))
  1061.         {
  1062.           warn_when_safe (Qresource, Qwarning, str);
  1063.           return Qnil;
  1064.         }
  1065.       else
  1066.         {
  1067.           return Fsignal (Qerror, list1 (build_string (str)));
  1068.         }
  1069.     }
  1070.       else
  1071.     return make_number (i);
  1072.     }
  1073.   else
  1074.     abort ();
  1075.  
  1076.   /* Can't get here. */
  1077.   return Qnil;    /* shut up compiler */
  1078. }
  1079.  
  1080. DEFUN ("x-get-resource-prefix", Fx_get_resource_prefix,
  1081.        Sx_get_resource_prefix, 1, 2, 0,
  1082.   "Return the resource prefix for LOCALE on DEVICE.\n\
  1083. The resource prefix is the strings used to prefix resources if\n\
  1084. the LOCALE and DEVICE arguments were passed to `x-get-resource'.\n\
  1085. The returned value is a cons of a name prefix and a class prefix.\n\
  1086. For example, if LOCALE is a frame, the returned value might be\n\
  1087. (\"xemacs.frame.FRAME-NAME\" . \"Emacs.EmacsLocaleType.EmacsFrame\").\n\
  1088. If no valid X device for resourcing can be obtained, this function\n\
  1089. returns nil. (In such a case, `x-get-resource' would always return nil.)")
  1090.   (locale, device)
  1091.   Lisp_Object locale, device;
  1092. {
  1093.   /* #### fixed limit, could be overflowed */
  1094.   char name[1024], class[1024];
  1095.   Display *display;
  1096.  
  1097.   x_get_resource_prefix (locale, device, &display, name, class);
  1098.   if (!display)
  1099.     return Qnil;
  1100.   return Fcons (build_string (name), build_string (class));
  1101. }
  1102.  
  1103. DEFUN ("x-put-resource", Fx_put_resource, Sx_put_resource, 1, 2, 0,
  1104.   "Add a resource to the resource database for DEVICE.\n\
  1105. RESOURCE-LINE specifies the resource to add and should be a\n\
  1106. standard resource specification.")
  1107.      (resource_line, device)
  1108.      Lisp_Object resource_line, device;
  1109. {
  1110.   struct device *d = get_device (device);
  1111.   char *str, *colon_pos;
  1112.  
  1113.   CHECK_STRING (resource_line, 0);
  1114.   str = (char *) string_data (XSTRING (resource_line));
  1115.   if (!(colon_pos = strchr (str, ':')) || strchr (str, '\n'))
  1116.   invalid:
  1117.     signal_simple_error ("Invalid resource line", resource_line);
  1118.   if (strspn (str,
  1119.           /* Only the following chars are allowed before the colon */
  1120.           " \t.*?abcdefghijklmnopqrstuvwxyz"
  1121.           "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-") != colon_pos - str)
  1122.     goto invalid;
  1123.  
  1124.   if (DEVICE_IS_X (d))
  1125.     {
  1126.       XrmDatabase db = XtDatabase (DEVICE_X_DISPLAY (d));
  1127.       XrmPutLineResource (&db, str);
  1128.     }
  1129.  
  1130.   return Qnil;
  1131. }
  1132.  
  1133.  
  1134. /************************************************************************/
  1135. /*                   display information functions                      */
  1136. /************************************************************************/
  1137.  
  1138. DEFUN ("default-x-device", Fdefault_x_device, Sdefault_x_device, 0, 0, 0,
  1139.        "Return the default X device for resourcing.\n\
  1140. This is the first-created X device that still exists.")
  1141.      ()
  1142. {
  1143.   return Vdefault_x_device;
  1144. }
  1145.  
  1146. DEFUN ("device-x-display", Fdevice_x_display, Sdevice_x_display, 0, 1, 0,
  1147.        "Return the X display which DEVICE is connected to, as a string.")
  1148.      (device)
  1149.      Lisp_Object device;
  1150. {
  1151.   struct device *d = get_x_device (device);
  1152.  
  1153.   return (make_string ((Bufbyte *) DEVICE_X_DATA (d)->display_name,
  1154.                strlen (DEVICE_X_DATA (d)->display_name)));
  1155. }
  1156.  
  1157. DEFUN ("device-x-argv-list", Fdevice_x_argv_list, Sdevice_x_argv_list, 0, 1, 0,
  1158.        "You should probably not be using this function.")
  1159.      (device)
  1160.      Lisp_Object device;
  1161. {
  1162.   struct device *d = get_x_device (device);
  1163.  
  1164.   return Fcopy_sequence (DEVICE_X_DATA (d)->argv_list);
  1165. }
  1166.  
  1167. DEFUN ("x-display-visual-class", Fx_display_visual_class,
  1168.        Sx_display_visual_class, 0, 1, 0,
  1169.        "Return the visual class of the X display `device' is on.\n\
  1170. The returned value will be one of the symbols `static-gray', `gray-scale',\n\
  1171. `static-color', `pseudo-color', `true-color', or `direct-color'.")
  1172.      (device)
  1173.      Lisp_Object device;
  1174. {
  1175.   switch (DefaultVisualOfScreen
  1176.       (DefaultScreenOfDisplay (get_x_display (device)))->class)
  1177.     {
  1178.     case StaticGray:  return (intern ("static-gray"));
  1179.     case GrayScale:   return (intern ("gray-scale"));
  1180.     case StaticColor: return (intern ("static-color"));
  1181.     case PseudoColor: return (intern ("pseudo-color"));
  1182.     case TrueColor:   return (intern ("true-color"));
  1183.     case DirectColor: return (intern ("direct-color"));
  1184.     default:
  1185.       error ("display has an unknown visual class");
  1186.     }
  1187.  
  1188.   return Qnil;    /* suppress compiler warning */
  1189. }
  1190.  
  1191. static int
  1192. x_device_pixel_width (struct device *d)
  1193. {
  1194.   Display *dpy = DEVICE_X_DISPLAY (d);
  1195.  
  1196.   return DisplayWidth (dpy, DefaultScreen (dpy));
  1197. }
  1198.  
  1199. static int
  1200. x_device_pixel_height (struct device *d)
  1201. {
  1202.   Display *dpy = DEVICE_X_DISPLAY (d);
  1203.  
  1204.   return DisplayHeight (dpy, DefaultScreen (dpy));
  1205. }
  1206.  
  1207. static int
  1208. x_device_mm_width (struct device *d)
  1209. {
  1210.   Display *dpy = DEVICE_X_DISPLAY (d);
  1211.  
  1212.   return DisplayWidthMM (dpy, DefaultScreen (dpy));
  1213. }
  1214.  
  1215. static int
  1216. x_device_mm_height (struct device *d)
  1217. {
  1218.   Display *dpy = DEVICE_X_DISPLAY (d);
  1219.  
  1220.   return DisplayHeightMM (dpy, DefaultScreen (dpy));
  1221. }
  1222.  
  1223. static int
  1224. x_device_bitplanes (struct device *d)
  1225. {
  1226.   Display *dpy = DEVICE_X_DISPLAY (d);
  1227.  
  1228.   return DisplayPlanes (dpy, DefaultScreen (dpy));
  1229. }
  1230.  
  1231. static int
  1232. x_device_color_cells (struct device *d)
  1233. {
  1234.   Display *dpy = DEVICE_X_DISPLAY (d);
  1235.  
  1236.   return DisplayCells (dpy, DefaultScreen (dpy));
  1237. }
  1238.  
  1239. DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
  1240.        "Return the vendor ID string of the X server `device' on.")
  1241.      (device)
  1242.   Lisp_Object device;
  1243. {
  1244.   Display *dpy = get_x_display (device);
  1245.   char *vendor = ServerVendor (dpy);
  1246.  
  1247.   if (vendor)
  1248.     return (build_string (vendor));
  1249.   else
  1250.     return (build_string (""));
  1251. }
  1252.  
  1253. DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
  1254.        "Return the version numbers of the X server `device' is on.\n\
  1255. The returned value is a list of three integers: the major and minor\n\
  1256. version numbers of the X Protocol in use, and the vendor-specific release\n\
  1257. number.  See also `x-server-vendor'.")
  1258.      (device)
  1259.   Lisp_Object device;
  1260. {
  1261.   Display *dpy = get_x_display (device);
  1262.  
  1263.   return list3 (make_number (ProtocolVersion (dpy)),
  1264.         make_number (ProtocolRevision (dpy)),
  1265.         make_number (VendorRelease (dpy)));
  1266. }
  1267.  
  1268. DEFUN ("x-valid-keysym-name-p", Fx_valid_keysym_name_p, Sx_valid_keysym_name_p,
  1269.        1, 1, 0,
  1270.   "Return true if KEYSYM names a keysym that the X library knows about.\n\
  1271. Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in\n\
  1272. /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system.")
  1273.      (keysym)
  1274.      Lisp_Object keysym;
  1275. {
  1276.   CHECK_STRING (keysym, 0);
  1277.   if (XStringToKeysym (string_ext_data (XSTRING (keysym))))
  1278.     return Qt;
  1279.   return Qnil;
  1280. }
  1281.  
  1282.  
  1283. /************************************************************************/
  1284. /*                          grabs and ungrabs                           */
  1285. /************************************************************************/
  1286.  
  1287. DEFUN ("x-grab-pointer", Fx_grab_pointer, Sx_grab_pointer, 0, 3, 0,
  1288.   "Grab the pointer and restrict it to its current window.\n\
  1289. If optional DEVICE argument is nil, the default device will be used.\n\
  1290. If optional CURSOR argument is non-nil, change the pointer shape to that\n\
  1291.  until `x-ungrab-pointer' is called (it should be an object returned by the\n\
  1292.  `make-cursor' function).\n\
  1293. If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all\n\
  1294.   keyboard  events during the grab.\n\
  1295. Returns t if the grab is successful, nil otherwise.")
  1296.   (device, cursor, ignore_keyboard)
  1297.      Lisp_Object device, cursor, ignore_keyboard;
  1298. {
  1299.   Window w;
  1300.   int pointer_mode, result;
  1301.   struct device *d = get_x_device (device);
  1302.  
  1303.   if (! NILP (cursor))
  1304.     CHECK_CURSOR (cursor, 0);
  1305.  
  1306.   if (! NILP (ignore_keyboard))
  1307.     pointer_mode = GrabModeSync;
  1308.   else
  1309.     pointer_mode = GrabModeAsync;
  1310.  
  1311.   w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d)));
  1312.  
  1313.   /* #### Possibly this needs to gcpro the cursor somehow, but it doesn't
  1314.      seem to cause a problem if XFreeCursor is called on a cursor in use
  1315.      in a grab; I suppose the X server counts the grab as a reference
  1316.      and doesn't free it until it exits? */
  1317.   result = XGrabPointer (DEVICE_X_DISPLAY (d), w,
  1318.              False,
  1319.              ButtonMotionMask | ButtonPressMask
  1320.              | ButtonReleaseMask | PointerMotionHintMask,
  1321.              GrabModeAsync,          /* Keep pointer events flowing */
  1322.              pointer_mode,          /* Stall keyboard events */
  1323.              w,              /* Stay in this window */
  1324.              (NILP (cursor) ? 0 : XCURSOR (cursor)->cursor),
  1325.              CurrentTime);
  1326.   return ((result == GrabSuccess) ? Qt : Qnil);
  1327. }
  1328.  
  1329. DEFUN ("x-ungrab-pointer", Fx_ungrab_pointer, Sx_ungrab_pointer, 0, 1, 0,
  1330.   "Release a pointer grab made with `x-grab-pointer'.\n\
  1331. If optional first arg DEVICE is nil the default device is used.\n\
  1332. If it is t the pointer will be released on all X devices.")
  1333.      (device)
  1334.      Lisp_Object device;
  1335. {
  1336.   if (!EQ (device, Qt))
  1337.     {
  1338.       Display *dpy = get_x_display (device);
  1339.       XUngrabPointer (dpy, CurrentTime);
  1340.     }
  1341.   else
  1342.     {
  1343.       Lisp_Object rest;
  1344.       DEVICE_LOOP (rest)
  1345.     {
  1346.       struct device *d = XDEVICE (XCAR (rest));
  1347.  
  1348.       if (DEVICE_IS_X (d))
  1349.         XUngrabPointer (DEVICE_X_DISPLAY (d), CurrentTime);
  1350.     }
  1351.     }
  1352.  
  1353.   return Qnil;
  1354. }
  1355.  
  1356. DEFUN ("x-grab-keyboard", Fx_grab_keyboard, Sx_grab_keyboard, 0, 1, 0,
  1357.   "Grab the keyboard on the given device (defaulting to the selected one).\n\
  1358. So long as the keyboard is grabbed, all keyboard events will be delivered\n\
  1359. to emacs -- it is not possible for other X clients to eavesdrop on them.\n\
  1360. Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect).\n\
  1361. Returns t if the grab was successful; nil otherwise.")
  1362.      (device)
  1363.      Lisp_Object device;
  1364. {
  1365.   struct device *d = get_x_device (device);
  1366.   Window w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d)));
  1367.   Display *dpy = DEVICE_X_DISPLAY (d);
  1368.   Status status;
  1369.   XSync (dpy, False);
  1370.   status = XGrabKeyboard (dpy, w, True,
  1371.               /* I don't really understand sync-vs-async
  1372.                  grabs, but this is what xterm does. */
  1373.               GrabModeAsync, GrabModeAsync,
  1374.               /* Use the timestamp of the last user action
  1375.                  read by emacs proper; xterm uses CurrentTime
  1376.                  but there's a comment that says "wrong"...
  1377.                  (Despite the name this is the time of the
  1378.                  last key or mouse event.) */
  1379.               DEVICE_X_MOUSE_TIMESTAMP (d));
  1380.   if (status == GrabSuccess)
  1381.     {
  1382.       /* The XUngrabKeyboard should generate a FocusIn back to this
  1383.          window but it doesn't unless we explicitly set focus to the
  1384.          window first (which should already have it.  The net result
  1385.          is that without this call when x-ungrab-keyboard is called
  1386.          the selected frame ends up not having focus. */
  1387.       XSetInputFocus (dpy, w, RevertToParent, DEVICE_X_MOUSE_TIMESTAMP (d));
  1388.       return Qt;
  1389.     }
  1390.   else
  1391.     return Qnil;
  1392. }
  1393.  
  1394. DEFUN ("x-ungrab-keyboard", Fx_ungrab_keyboard, Sx_ungrab_keyboard, 0, 1, 0,
  1395.        "Release a keyboard grab made with `x-grab-keyboard'.")
  1396.      (device)
  1397.      Lisp_Object device;
  1398. {
  1399.   Display *dpy = get_x_display (device);
  1400.   XUngrabKeyboard (dpy, CurrentTime);
  1401.   return Qnil;
  1402. }
  1403.  
  1404.  
  1405. /************************************************************************/
  1406. /*                            initialization                            */
  1407. /************************************************************************/
  1408.  
  1409. void
  1410. syms_of_device_x (void)
  1411. {
  1412.   defsubr (&Sx_debug_mode);
  1413.   defsubr (&Sx_get_resource);
  1414.   defsubr (&Sx_get_resource_prefix);
  1415.   defsubr (&Sx_put_resource);
  1416.  
  1417.   defsubr (&Sdefault_x_device);
  1418.   defsubr (&Sdevice_x_display);
  1419.   defsubr (&Sdevice_x_argv_list);
  1420.   defsubr (&Sx_display_visual_class);
  1421.   defsubr (&Sx_server_vendor);
  1422.   defsubr (&Sx_server_version);
  1423.   defsubr (&Sx_valid_keysym_name_p);
  1424.  
  1425.   defsubr (&Sx_grab_pointer);
  1426.   defsubr (&Sx_ungrab_pointer);
  1427.   defsubr (&Sx_grab_keyboard);
  1428.   defsubr (&Sx_ungrab_keyboard);
  1429.  
  1430.   defsymbol (&Qargv_list, "argv-list");
  1431.   defsymbol (&Qx_error, "x-error");
  1432.  
  1433. }
  1434.  
  1435. void
  1436. device_type_create_x (void)
  1437. {
  1438.   INITIALIZE_DEVICE_TYPE (x, "x", "device-x-p");
  1439.  
  1440.   DEVICE_HAS_METHOD (x, init_device);
  1441.   DEVICE_HAS_METHOD (x, initially_selected_for_input);
  1442.   DEVICE_HAS_METHOD (x, mark_device);
  1443.   DEVICE_HAS_METHOD (x, delete_device);
  1444.   DEVICE_HAS_METHOD (x, device_pixel_width);
  1445.   DEVICE_HAS_METHOD (x, device_pixel_height);
  1446.   DEVICE_HAS_METHOD (x, device_mm_width);
  1447.   DEVICE_HAS_METHOD (x, device_mm_height);
  1448.   DEVICE_HAS_METHOD (x, device_bitplanes);
  1449.   DEVICE_HAS_METHOD (x, device_color_cells);
  1450. }
  1451.  
  1452. void
  1453. vars_of_device_x (void)
  1454. {
  1455.   DEFVAR_LISP ("x-emacs-application-class", &Vx_emacs_application_class,
  1456.            "The X application class of the XEmacs process.\n\
  1457. This controls, among other things, the name of the `app-defaults' file\n\
  1458. that XEmacs will use.  For changes to this variable to take effect, they\n\
  1459. must be made before the connection to the X server is initialized, that is,\n\
  1460. this variable may only be changed before emacs is dumped, or by setting it\n\
  1461. in the file lisp/term/x-win.el.");
  1462.   Vx_emacs_application_class = Fpurecopy (build_string ("Emacs"));
  1463.  
  1464.   Fprovide (Qx);
  1465.  
  1466.   staticpro (&Vdefault_x_device);
  1467.   Vdefault_x_device = Qnil;
  1468.  
  1469.   error_expected = 0;
  1470.   error_occurred = 0;
  1471.  
  1472.   in_resource_setting = 0;
  1473.   in_specifier_change_function = 0;
  1474. }
  1475.