(M17260): Separate U+6CBF, J90-3168 and C1-4E58.
[chise/xemacs-chise.git] / src / process-nt.c
index 0b92984..2afa597 100644 (file)
@@ -53,6 +53,7 @@ Lisp_Object Qnt_quote_process_args;
 struct nt_process_data
 {
   HANDLE h_process;
+  int need_enable_child_signals;
 };
 
 #define NT_DATA(p) ((struct nt_process_data*)((p)->process_data))
@@ -421,7 +422,7 @@ nt_create_process (struct Lisp_Process *p,
                   Lisp_Object *argv, int nargv,
                   Lisp_Object program, Lisp_Object cur_dir)
 {
-  HANDLE hmyshove, hmyslurp, hprocin, hprocout;
+  HANDLE hmyshove, hmyslurp, hprocin, hprocout, hprocerr;
   LPTSTR command_line;
   BOOL do_io, windowed;
   char *proc_env;
@@ -472,6 +473,10 @@ nt_create_process (struct Lisp_Process *p,
       CreatePipe (&hprocin, &hmyshove, &sa, 0);
       CreatePipe (&hmyslurp, &hprocout, &sa, 0);
 
+      /* Duplicate the stdout handle for use as stderr */
+      DuplicateHandle(GetCurrentProcess(), hprocout, GetCurrentProcess(), &hprocerr,
+       0, TRUE, DUPLICATE_SAME_ACCESS);
+
       /* Stupid Win32 allows to create a pipe with *both* ends either
         inheritable or not. We need process ends inheritable, and local
         ends not inheritable. */
@@ -599,7 +604,7 @@ nt_create_process (struct Lisp_Process *p,
       {
        si.hStdInput = hprocin;
        si.hStdOutput = hprocout;
-       si.hStdError = hprocout;
+       si.hStdError = hprocerr;
        si.dwFlags |= STARTF_USESTDHANDLES;
       }
 
@@ -614,6 +619,7 @@ nt_create_process (struct Lisp_Process *p,
        /* These just have been inherited; we do not need a copy */
        CloseHandle (hprocin);
        CloseHandle (hprocout);
+       CloseHandle (hprocerr);
       }
     
     /* Handle process creation failure */
@@ -640,15 +646,19 @@ nt_create_process (struct Lisp_Process *p,
        CloseHandle (pi.hProcess);
       }
 
-    if (!windowed)
-      enable_child_signals (pi.hProcess);
-
     ResumeThread (pi.hThread);
     CloseHandle (pi.hThread);
 
-    /* Hack to support Windows 95 negative pids */
-    return ((int)pi.dwProcessId < 0
-           ? -(int)pi.dwProcessId : (int)pi.dwProcessId);
+    /* Remember to enable child signals later if this is not a windowed
+       app.  Can't do it right now because that screws up the MKS Toolkit
+       shell. */
+    if (!windowed)
+      {
+       NT_DATA(p)->need_enable_child_signals = 10;
+       kick_status_notify ();
+      }
+
+    return ((int)pi.dwProcessId);
   }
 }
 
@@ -664,6 +674,18 @@ static void
 nt_update_status_if_terminated (struct Lisp_Process* p)
 {
   DWORD exit_code;
+
+  if (NT_DATA(p)->need_enable_child_signals > 1)
+    {
+      NT_DATA(p)->need_enable_child_signals -= 1;
+      kick_status_notify ();
+    }
+  else if (NT_DATA(p)->need_enable_child_signals == 1)
+    {
+      enable_child_signals(NT_DATA(p)->h_process);
+      NT_DATA(p)->need_enable_child_signals = 0;
+    }
+
   if (GetExitCodeProcess (NT_DATA(p)->h_process, &exit_code)
       && exit_code != STILL_ACTIVE)
     {
@@ -695,7 +717,8 @@ nt_update_status_if_terminated (struct Lisp_Process* p)
 static void
 nt_send_process (Lisp_Object proc, struct lstream* lstream)
 {
-  struct Lisp_Process *p = XPROCESS (proc);
+  volatile Lisp_Object vol_proc = proc;
+  struct Lisp_Process *volatile p = XPROCESS (proc);
 
   /* use a reasonable-sized buffer (somewhere around the size of the
      stream buffer) so as to avoid inundating the stream with blocked
@@ -705,7 +728,7 @@ nt_send_process (Lisp_Object proc, struct lstream* lstream)
 
   while (1)
     {
-      int writeret;
+      ssize_t writeret;
 
       chunklen = Lstream_read (lstream, chunkbuf, 128);
       if (chunklen <= 0)
@@ -725,7 +748,7 @@ nt_send_process (Lisp_Object proc, struct lstream* lstream)
          p->core_dumped = 0;
          p->tick++;
          process_tick++;
-         deactivate_process (proc);
+         deactivate_process (*((Lisp_Object *) (&vol_proc)));
          error ("Broken pipe error sending to process %s; closed it",
                 XSTRING_DATA (p->name));
        }
@@ -765,6 +788,14 @@ nt_kill_child_process (Lisp_Object proc, int signo,
 {
   struct Lisp_Process *p = XPROCESS (proc);
 
+  /* Enable child signals if necessary.  This may lose the first
+     but it's better than nothing. */
+  if (NT_DATA(p)->need_enable_child_signals > 0)
+    {
+      enable_child_signals(NT_DATA(p)->h_process);
+      NT_DATA(p)->need_enable_child_signals = 0;
+    }
+
   /* Signal error if SIGNO cannot be sent */
   validate_signal_number (signo);
 
@@ -858,6 +889,12 @@ get_internet_address (Lisp_Object host, struct sockaddr_in *address,
          /* Ok, got an answer */
          if (WSAGETASYNCERROR(msg.lParam) == NO_ERROR)
            success = 1;
+         else
+           {
+             warn_when_safe(Qstream, Qwarning,
+                            "cannot get IP address for host \"%s\"",
+                            XSTRING_DATA (host));
+           }
          goto done;
        }
       else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID)
@@ -948,7 +985,6 @@ nt_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service,
   retval = connect (s, (struct sockaddr *) &address, sizeof (address));
   if (retval != NO_ERROR && WSAGetLastError() != WSAEWOULDBLOCK)
     goto connect_failed;
-
   /* Wait while connection is established */
   while (1)
     {
@@ -991,6 +1027,18 @@ nt_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service,
 
  connect_failed:  
   closesocket (s);
+  if (INTP (service)) {
+    warn_when_safe(Qstream, Qwarning,
+                  "failure to open network stream to host \"%s\" for service \"%d\"",
+                  XSTRING_DATA (host),
+                  (unsigned short) XINT (service));
+  }
+  else {
+    warn_when_safe(Qstream, Qwarning,
+                  "failure to open network stream to host \"%s\" for service \"%s\"",
+                  XSTRING_DATA (host),
+                  XSTRING_DATA (service));
+  }
   report_file_error ("connection failed", list2 (host, name));
 }