XEmacs 21.4.7 "Economic Science".

[chise/xemacs-chise.git.1] / src / device-x.c

diff --git a/src/device-x.c b/src/device-x.c
index 27e7daf..4bfa4b0 100644 (file)
--- a/src/device-x.c
+++ b/src/device-x.c
@@ -21,6 +21,8 @@ Boston, MA 02111-1307, USA.  */
 
 /* Synched up with: Not in FSF. */
 
 
 /* Synched up with: Not in FSF. */
 

+/* 7-8-00 !!#### This file needs definite Mule review. */
+

 /* Original authors: Jamie Zawinski and the FSF */
 /* Rewritten by Ben Wing and Chuck Thompson. */
 
 /* Original authors: Jamie Zawinski and the FSF */
 /* Rewritten by Ben Wing and Chuck Thompson. */
 

@@ -166,6 +168,8 @@ get_x_display (Lisp_Object device)
 /*                   initializing an X connection                      */
 /************************************************************************/
 
 /*                   initializing an X connection                      */
 /************************************************************************/
 

+static struct device *device_being_initialized = NULL;
+

 static void
 allocate_x_device_struct (struct device *d)
 {
 static void
 allocate_x_device_struct (struct device *d)
 {

@@ -246,11 +250,11 @@ x_init_device_class (struct device *d)
  * Finally, if all else fails, return `xemacs', as it is more
  * appropriate (X11R5 returns `main').
  */
  * Finally, if all else fails, return `xemacs', as it is more
  * appropriate (X11R5 returns `main').
  */

-static char *
-compute_x_app_name (int argc, char **argv)
+static Extbyte *
+compute_x_app_name (int argc, Extbyte **argv)

 {
   int i;
 {
   int i;

-  char *ptr;
+  Extbyte *ptr;

 
   for (i = 1; i < argc - 1; i++)
     if (!strncmp(argv[i], "-name", max (2, strlen (argv[1]))))
 
   for (i = 1; i < argc - 1; i++)
     if (!strncmp(argv[i], "-name", max (2, strlen (argv[1]))))

@@ -459,7 +463,7 @@ x_init_device (struct device *d, Lisp_Object props)
   Display *dpy;
   Widget app_shell;
   int argc;
   Display *dpy;
   Widget app_shell;
   int argc;

-  char **argv;
+  Extbyte **argv;

   const char *app_class;
   const char *app_name;
   const char *disp_name;
   const char *app_class;
   const char *app_name;
   const char *disp_name;

@@ -549,9 +553,7 @@ x_init_device (struct device *d, Lisp_Object props)
 
   make_argc_argv (Vx_initial_argv_list, &argc, &argv);
 
 
   make_argc_argv (Vx_initial_argv_list, &argc, &argv);
 

-  TO_EXTERNAL_FORMAT (LISP_STRING, display,
-                     C_STRING_ALLOCA, disp_name,
-                     Qctext);
+  LISP_STRING_TO_EXTERNAL (display, disp_name, Qctext);

 
   /*
    * Break apart the old XtOpenDisplay call into XOpenDisplay and
 
   /*
    * Break apart the old XtOpenDisplay call into XOpenDisplay and

@@ -562,7 +564,9 @@ x_init_device (struct device *d, Lisp_Object props)
    */
   slow_down_interrupts ();
   /* May not be needed but XtOpenDisplay could not deal with signals here. */
    */
   slow_down_interrupts ();
   /* May not be needed but XtOpenDisplay could not deal with signals here. */

+  device_being_initialized = d;

   dpy = DEVICE_X_DISPLAY (d) = XOpenDisplay (disp_name);
   dpy = DEVICE_X_DISPLAY (d) = XOpenDisplay (disp_name);

+  device_being_initialized = NULL;

   speed_up_interrupts ();
 
   if (dpy == 0)
   speed_up_interrupts ();
 
   if (dpy == 0)

@@ -573,9 +577,7 @@ x_init_device (struct device *d, Lisp_Object props)
 
   if (STRINGP (Vx_emacs_application_class) &&
       XSTRING_LENGTH (Vx_emacs_application_class) > 0)
 
   if (STRINGP (Vx_emacs_application_class) &&
       XSTRING_LENGTH (Vx_emacs_application_class) > 0)

-    TO_EXTERNAL_FORMAT (LISP_STRING, Vx_emacs_application_class,
-                       C_STRING_ALLOCA, app_class,
-                       Qctext);
+    LISP_STRING_TO_EXTERNAL (Vx_emacs_application_class, app_class, Qctext);

   else
     {
       app_class = (NILP (Vx_emacs_application_class)  &&
   else
     {
       app_class = (NILP (Vx_emacs_application_class)  &&

@@ -595,7 +597,7 @@ x_init_device (struct device *d, Lisp_Object props)
      Yuck. */
   XtDisplayInitialize (Xt_app_con, dpy, compute_x_app_name (argc, argv),
                        app_class, emacs_options,
      Yuck. */
   XtDisplayInitialize (Xt_app_con, dpy, compute_x_app_name (argc, argv),
                        app_class, emacs_options,

-                       XtNumber (emacs_options), &argc, argv);
+                       XtNumber (emacs_options), &argc, (char **) argv);

   speed_up_interrupts ();
 
   screen = DefaultScreen (dpy);
   speed_up_interrupts ();
 
   screen = DefaultScreen (dpy);

@@ -617,9 +619,7 @@ x_init_device (struct device *d, Lisp_Object props)
     if (STRINGP (Vx_app_defaults_directory) &&
        XSTRING_LENGTH (Vx_app_defaults_directory) > 0)
       {
     if (STRINGP (Vx_app_defaults_directory) &&
        XSTRING_LENGTH (Vx_app_defaults_directory) > 0)
       {

-       TO_EXTERNAL_FORMAT (LISP_STRING, Vx_app_defaults_directory,
-                           C_STRING_ALLOCA, data_dir,
-                           Qfile_name);
+       LISP_STRING_TO_EXTERNAL (Vx_app_defaults_directory, data_dir, Qfile_name);

        path = (char *)alloca (strlen (data_dir) + strlen (locale) + 7);
        sprintf (path, "%s%s/Emacs", data_dir, locale);
        if (!access (path, R_OK))
        path = (char *)alloca (strlen (data_dir) + strlen (locale) + 7);
        sprintf (path, "%s%s/Emacs", data_dir, locale);
        if (!access (path, R_OK))

@@ -627,9 +627,7 @@ x_init_device (struct device *d, Lisp_Object props)
       }
     else if (STRINGP (Vdata_directory) && XSTRING_LENGTH (Vdata_directory) > 0)
       {
       }
     else if (STRINGP (Vdata_directory) && XSTRING_LENGTH (Vdata_directory) > 0)
       {

-       TO_EXTERNAL_FORMAT (LISP_STRING, Vdata_directory,
-                           C_STRING_ALLOCA, data_dir,
-                           Qfile_name);
+       LISP_STRING_TO_EXTERNAL (Vdata_directory, data_dir, Qfile_name);

        path = (char *)alloca (strlen (data_dir) + 13 + strlen (locale) + 7);
        sprintf (path, "%sapp-defaults/%s/Emacs", data_dir, locale);
        if (!access (path, R_OK))
        path = (char *)alloca (strlen (data_dir) + 13 + strlen (locale) + 7);
        sprintf (path, "%sapp-defaults/%s/Emacs", data_dir, locale);
        if (!access (path, R_OK))

@@ -785,9 +783,10 @@ x_init_device (struct device *d, Lisp_Object props)
 #ifdef HAVE_WMCOMMAND
   {
     int new_argc;
 #ifdef HAVE_WMCOMMAND
   {
     int new_argc;

-    char **new_argv;
+    Extbyte **new_argv;

     make_argc_argv (Vcommand_line_args, &new_argc, &new_argv);
     make_argc_argv (Vcommand_line_args, &new_argc, &new_argv);

-    XSetCommand (XtDisplay (app_shell), XtWindow (app_shell), new_argv, new_argc);
+    XSetCommand (XtDisplay (app_shell), XtWindow (app_shell),
+                (char **) new_argv, new_argc);

     free_argc_argv (new_argv);
   }
 #endif /* HAVE_WMCOMMAND */
     free_argc_argv (new_argv);
   }
 #endif /* HAVE_WMCOMMAND */

@@ -1121,6 +1120,9 @@ x_IO_error_handler (Display *disp)
   Lisp_Object dev;
   struct device *d = get_device_from_display_1 (disp);
 
   Lisp_Object dev;
   struct device *d = get_device_from_display_1 (disp);
 

+  if (!d)
+    d = device_being_initialized;
+

   assert (d != NULL);
   XSETDEVICE (dev, d);
 
   assert (d != NULL);
   XSETDEVICE (dev, d);
 

@@ -1259,6 +1261,22 @@ construct_name_list (Display *display, Widget widget, char *fake_name,
 
 #endif /* 0 */
 
 
 #endif /* 0 */
 

+/* strcasecmp() is not sufficiently portable or standard,
+   and it's easier just to write our own. */
+static int
+ascii_strcasecmp (const char *s1, const char *s2)
+{
+  while (1)
+    {
+      char c1 = *s1++;
+      char c2 = *s2++;
+      if (c1 >= 'A' && c1 <= 'Z') c1 += 'a' - 'A';
+      if (c2 >= 'A' && c2 <= 'Z') c2 += 'a' - 'A';
+      if (c1 != c2) return c1 - c2;
+      if (c1 == '\0') return 0;
+    }
+}
+

 static char_dynarr *name_char_dynarr;
 static char_dynarr *class_char_dynarr;
 
 static char_dynarr *name_char_dynarr;
 static char_dynarr *class_char_dynarr;
 

@@ -1362,7 +1380,7 @@ The fifth arg is the device to search for the resources on. (The resource
 The sixth arg NOERROR, if non-nil, means do not signal an error if a
   bogus resource specification was retrieved (e.g. if a non-integer was
   given when an integer was requested).  In this case, a warning is issued
 The sixth arg NOERROR, if non-nil, means do not signal an error if a
   bogus resource specification was retrieved (e.g. if a non-integer was
   given when an integer was requested).  In this case, a warning is issued

-  instead.
+  instead, unless NOERROR is t, in which case no warning is issued.

 
 The resource names passed to this function are looked up relative to the
 locale.
 
 The resource names passed to this function are looked up relative to the
 locale.

@@ -1423,13 +1441,13 @@ found.  If the third arg is `string', a string is returned, and if it is
 returned value is the list (t) for true, (nil) for false, and is nil to
 mean ``unspecified''.
 */
 returned value is the list (t) for true, (nil) for false, and is nil to
 mean ``unspecified''.
 */

-       (name, class, type, locale, device, no_error))
+       (name, class, type, locale, device, noerror))

 {
   char* name_string, *class_string;
   char *raw_result;
   XrmDatabase db;
   Display *display;
 {
   char* name_string, *class_string;
   char *raw_result;
   XrmDatabase db;
   Display *display;

-  Error_behavior errb = decode_error_behavior_flag (no_error);
+  Error_behavior errb = decode_error_behavior_flag (noerror);

 
   CHECK_STRING (name);
   CHECK_STRING (class);
 
   CHECK_STRING (name);
   CHECK_STRING (class);

@@ -1485,13 +1503,13 @@ mean ``unspecified''.
     return build_string (raw_result);
   else if (EQ (type, Qboolean))
     {
     return build_string (raw_result);
   else if (EQ (type, Qboolean))
     {

-      if (!strcasecmp (raw_result, "off")   ||
-         !strcasecmp (raw_result, "false") ||
-         !strcasecmp (raw_result, "no"))
+      if (!ascii_strcasecmp (raw_result, "off")   ||
+         !ascii_strcasecmp (raw_result, "false") ||
+         !ascii_strcasecmp (raw_result, "no"))

        return Fcons (Qnil, Qnil);
        return Fcons (Qnil, Qnil);

-      if (!strcasecmp (raw_result, "on")   ||
-         !strcasecmp (raw_result, "true") ||
-         !strcasecmp (raw_result, "yes"))
+      if (!ascii_strcasecmp (raw_result, "on")   ||
+         !ascii_strcasecmp (raw_result, "true") ||
+         !ascii_strcasecmp (raw_result, "yes"))

        return Fcons (Qt, Qnil);
       return maybe_continuable_error
        (Qresource, errb,
        return Fcons (Qt, Qnil);
       return maybe_continuable_error
        (Qresource, errb,

@@ -1687,9 +1705,7 @@ Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in
   const char *keysym_ext;
 
   CHECK_STRING (keysym);
   const char *keysym_ext;
 
   CHECK_STRING (keysym);

-  TO_EXTERNAL_FORMAT (LISP_STRING, keysym,
-                     C_STRING_ALLOCA, keysym_ext,
-                     Qctext);
+  LISP_STRING_TO_EXTERNAL (keysym, keysym_ext, Qctext);

 
   return XStringToKeysym (keysym_ext) ? Qt : Qnil;
 }
 
   return XStringToKeysym (keysym_ext) ? Qt : Qnil;
 }

@@ -1935,9 +1951,7 @@ See also `x-get-font-path'.
 
   EXTERNAL_LIST_LOOP (path_entry, font_path)
     {
 
   EXTERNAL_LIST_LOOP (path_entry, font_path)
     {

-      TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (path_entry),
-                         C_STRING_ALLOCA, directories[i++],
-                         Qfile_name);
+      LISP_STRING_TO_EXTERNAL (XCAR (path_entry), directories[i++], Qfile_name);

     }
 
   expect_x_error (dpy);
     }
 
   expect_x_error (dpy);