(Fformat_network_address): Fix int/Lisp_Object mixup.
[bpt/emacs.git] / src / process.c
index 226e818..2f2017d 100644 (file)
@@ -102,6 +102,10 @@ Boston, MA 02111-1307, USA.  */
 #ifdef IRIS
 #include <sys/sysmacros.h>     /* for "minor" */
 #endif /* not IRIS */
+  
+#ifdef HAVE_SYS_WAIT
+#include <sys/wait.h>
+#endif
 
 #include "systime.h"
 #include "systty.h"
@@ -330,6 +334,9 @@ static int pty_max_bytes;
 extern Lisp_Object Vfile_name_coding_system, Vdefault_file_name_coding_system;
 
 #ifdef HAVE_PTYS
+#ifdef HAVE_PTY_H
+#include <pty.h>
+#endif
 /* The file name of the pty opened by allocate_pty.  */
 
 static char pty_name[24];
@@ -419,7 +426,7 @@ status_message (status)
        signame = "unknown";
       string = build_string (signame);
       string2 = build_string (coredump ? " (core dumped)\n" : "\n");
-      XSTRING (string)->data[0] = DOWNCASE (XSTRING (string)->data[0]);
+      SSET (string, 0, DOWNCASE (SREF (string, 0)));
       return concat2 (string, string2);
     }
   else if (EQ (symbol, Qexit))
@@ -637,7 +644,7 @@ get_process (name)
       if (NILP (obj))
        obj = Fget_buffer (name);
       if (NILP (obj))
-       error ("Process %s does not exist", XSTRING (name)->data);
+       error ("Process %s does not exist", SDATA (name));
     }
   else if (NILP (name))
     obj = Fcurrent_buffer ();
@@ -650,7 +657,7 @@ get_process (name)
     {
       proc = Fget_buffer_process (obj);
       if (NILP (proc))
-       error ("Buffer %s has no process", XSTRING (XBUFFER (obj)->name)->data);
+       error ("Buffer %s has no process", SDATA (XBUFFER (obj)->name));
     }
   else
     {
@@ -1043,6 +1050,54 @@ a socket connection.  */)
   return XPROCESS (process)->type;
 }
 #endif
+
+#ifdef HAVE_SOCKETS
+DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
+       1, 1, 0,
+       doc: /* Convert network ADDRESS from internal format to a string.
+Returns nil if format of ADDRESS is invalid.  */)
+     (address)
+     Lisp_Object address;
+{
+  register struct Lisp_Vector *p;
+  register unsigned char *cp;
+  register int i;
+
+  if (NILP (address))
+    return Qnil;
+
+  if (STRINGP (address))  /* AF_LOCAL */
+    return address;
+
+  if (VECTORP (address))  /* AF_INET */
+    {
+      register struct Lisp_Vector *p = XVECTOR (address);
+      Lisp_Object args[6];
+
+      if (p->size != 5)
+       return Qnil;
+
+      args[0] = build_string ("%d.%d.%d.%d:%d");
+      args[1] = p->contents[0];
+      args[2] = p->contents[1];
+      args[3] = p->contents[2];
+      args[4] = p->contents[3];
+      args[5] = p->contents[4];
+      return Fformat (6, args);
+    }
+
+  if (CONSP (address))
+    {
+      Lisp_Object args[2];
+      args[0] = build_string ("<Family %d>");
+      args[1] = Fcar (address);
+      return Fformat (2, args);
+      
+    }
+
+  return Qnil;
+}
+#endif
 \f
 Lisp_Object
 list_processes_1 (query_only)
@@ -1070,17 +1125,17 @@ list_processes_1 (query_only)
       if (!NILP (query_only) && !NILP (p->kill_without_query))
        continue;
       if (STRINGP (p->name)
-         && ( i = XSTRING (p->name)->size, (i > w_proc)))
+         && ( i = SCHARS (p->name), (i > w_proc)))
        w_proc = i;
       if (!NILP (p->buffer))
        {
          if (NILP (XBUFFER (p->buffer)->name) && w_buffer < 8)
            w_buffer = 8;  /* (Killed) */
-         else if ((i = XSTRING (XBUFFER (p->buffer)->name)->size, (i > w_buffer)))
+         else if ((i = SCHARS (XBUFFER (p->buffer)->name), (i > w_buffer)))
            w_buffer = i;
        }
       if (STRINGP (p->tty_name)
-         && (i = XSTRING (p->tty_name)->size, (i > w_tty)))
+         && (i = SCHARS (p->tty_name), (i > w_tty)))
        w_tty = i;
     }
 
@@ -1204,9 +1259,11 @@ list_processes_1 (query_only)
          Lisp_Object port = Fplist_get (p->childp, QCservice);
          if (INTEGERP (port))
            port = Fnumber_to_string (port);
+         if (NILP (port))
+           port = Fformat_network_address (Fplist_get (p->childp, QClocal));
          sprintf (tembuf, "(network %s server on %s)\n",
                   (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
-                  XSTRING (port)->data);
+                  (STRINGP (port) ? (char *)SDATA (port) : "?"));
          insert_string (tembuf);
        }
       else if (NETCONN1_P (p))
@@ -1220,9 +1277,11 @@ list_processes_1 (query_only)
              if (INTEGERP (host))
                host = Fnumber_to_string (host);
            }
+         if (NILP (host))
+           host = Fformat_network_address (Fplist_get (p->childp, QCremote));
          sprintf (tembuf, "(network %s connection to %s)\n",
                   (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
-                  XSTRING (host)->data);
+                  (STRINGP (host) ? (char *)SDATA (host) : "?"));
          insert_string (tembuf);
         }
       else 
@@ -1292,7 +1351,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS)  */)
   register unsigned char **new_argv;
 #endif
   register int i;
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
 
   buffer = args[1];
   if (!NILP (buffer))
@@ -1400,31 +1459,32 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS)  */)
 #ifdef VMS
   /* Make a one member argv with all args concatenated
      together separated by a blank.  */
-  len = STRING_BYTES (XSTRING (program)) + 2;
+  len = SBYTES (program) + 2;
   for (i = 3; i < nargs; i++)
     {
       tem = args[i];
       CHECK_STRING (tem);
-      len += STRING_BYTES (XSTRING (tem)) + 1; /* count the blank */
+      len += SBYTES (tem) + 1; /* count the blank */
     }
   new_argv = (unsigned char *) alloca (len);
-  strcpy (new_argv, XSTRING (program)->data);
+  strcpy (new_argv, SDATA (program));
   for (i = 3; i < nargs; i++)
     {
       tem = args[i];
       CHECK_STRING (tem);
       strcat (new_argv, " ");
-      strcat (new_argv, XSTRING (tem)->data);
+      strcat (new_argv, SDATA (tem));
     }
   /* Need to add code here to check for program existence on VMS */
   
 #else /* not VMS */
   new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
 
-  /* If program file name is not absolute, search our path for it */
-  if (!IS_DIRECTORY_SEP (XSTRING (program)->data[0])
-      && !(XSTRING (program)->size > 1
-          && IS_DEVICE_SEP (XSTRING (program)->data[1])))
+  /* If program file name is not absolute, search our path for it.
+     Put the name we will really use in TEM.  */
+  if (!IS_DIRECTORY_SEP (SREF (program, 0))
+      && !(SCHARS (program) > 1
+          && IS_DEVICE_SEP (SREF (program, 1))))
     {
       struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 
@@ -1435,18 +1495,25 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS)  */)
       if (NILP (tem))
        report_file_error ("Searching for program", Fcons (program, Qnil));
       tem = Fexpand_file_name (tem, Qnil);
-      tem = ENCODE_FILE (tem);
-      new_argv[0] = XSTRING (tem)->data;
     }
   else
     {
       if (!NILP (Ffile_directory_p (program)))
        error ("Specified program for new process is a directory");
-
-      tem = ENCODE_FILE (program);
-      new_argv[0] = XSTRING (tem)->data;
+      tem = program;
     }
 
+  /* If program file name starts with /: for quoting a magic name,
+     discard that.  */
+  if (SBYTES (tem) > 2 && SREF (tem, 0) == '/'
+      && SREF (tem, 1) == ':')
+    tem = Fsubstring (tem, make_number (2), Qnil);
+
+  /* Encode the file name and put it in NEW_ARGV.
+     That's where the child will use it to execute the program.  */
+  tem = ENCODE_FILE (tem);
+  new_argv[0] = SDATA (tem);
+
   /* Here we encode arguments by the coding system used for sending
      data to the process.  We don't support using different coding
      systems for encoding arguments and for encoding data sent to the
@@ -1459,7 +1526,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS)  */)
       if (STRING_MULTIBYTE (tem))
        tem = (code_convert_string_norecord
               (tem, XPROCESS (proc)->encode_coding_system, 1));
-      new_argv[i - 2] = XSTRING (tem)->data;
+      new_argv[i - 2] = SDATA (tem);
     }
   new_argv[i - 2] = 0;
 #endif /* not VMS */
@@ -1562,9 +1629,9 @@ create_process (process, new_argv, current_dir)
 
   if (inchannel >= 0)
     {
-#ifndef USG 
-      /* On USG systems it does not work to open the pty's tty here
-              and then close and reopen it in the child.  */
+#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
+      /* On most USG systems it does not work to open the pty's tty here,
+        then close it and reopen it in the child.  */
 #ifdef O_NOCTTY
       /* Don't let this terminal become our controlling terminal
         (in case we don't have one).  */
@@ -1576,7 +1643,7 @@ create_process (process, new_argv, current_dir)
        report_file_error ("Opening pty", Qnil);
 #else
       forkin = forkout = -1;
-#endif /* not USG */
+#endif /* not USG, or USG_SUBTTY_WORKS */
       pty_flag = 1;
     }
   else
@@ -2092,7 +2159,7 @@ conv_lisp_to_sockaddr (family, address, sa, len)
       if (family == AF_LOCAL)
        {
          struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
-         cp = XSTRING (address)->data;
+         cp = SDATA (address);
          for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
            sockun->sun_path[i] = *cp++;
        }
@@ -2232,9 +2299,9 @@ set_socket_options (s, opts, no_error)
          opt = XCAR (opt);
        }
       if (STRINGP (opt))
-       name = (char *) XSTRING (opt)->data;
+       name = (char *) SDATA (opt);
       else if (SYMBOLP (opt))
-       name = (char *) XSYMBOL (opt)->name->data;
+       name = (char *) SDATA (SYMBOL_NAME (opt));
       else {
        error ("Mal-formed option list");
        return 0;
@@ -2300,9 +2367,9 @@ set_socket_options (s, opts, no_error)
                if (NILP (val))
                  arg = "";
                else if (STRINGP (val))
-                 arg = (char *) XSTRING (val)->data;
+                 arg = (char *) SDATA (val);
                else if (XSYMBOL (val))
-                 arg = (char *) XSYMBOL (val)->name->data;
+                 arg = (char *) SDATA (SYMBOL_NAME (val));
                else 
                  error ("Invalid argument to %s option", name);
              }
@@ -2490,7 +2557,7 @@ The stopped state is cleared by `continue-process' and set by
 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
 
 :log LOG -- Install LOG as the server process log function.  This
-function is called as when the server accepts a network connection from a
+function is called when the server accepts a network connection from a
 client.  The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
 is the server process, CLIENT is the new process for the connection,
 and MESSAGE is a string.
@@ -2515,9 +2582,8 @@ addressing information (typically an IP address and a port number).
 
 Notice that the FILTER and SENTINEL args are never used directly by
 the server process.  Also, the BUFFER argument is not used directly by
-the server process, but via `network-server-log-function' hook, a log
-of the accepted (and failed) connections may be recorded in the server
-process' buffer.
+the server process, but via the optional :log function, accepted (and
+failed) connections may be logged in the server process' buffer.
 
 usage: (make-network-process &rest ARGS)  */)
      (nargs, args)
@@ -2552,7 +2618,7 @@ usage: (make-network-process &rest ARGS)  */)
   int s = -1, outch, inch;
   struct gcpro gcpro1;
   int retry = 0;
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
   int count1;
   Lisp_Object QCaddress;  /* one of QClocal or QCremote */
   Lisp_Object tem;
@@ -2632,16 +2698,16 @@ usage: (make-network-process &rest ARGS)  */)
     {
       struct servent *svc_info;
       CHECK_STRING (service);
-      svc_info = getservbyname (XSTRING (service)->data, "tcp");
+      svc_info = getservbyname (SDATA (service), "tcp");
       if (svc_info == 0)
-       error ("Unknown service: %s", XSTRING (service)->data);
+       error ("Unknown service: %s", SDATA (service));
       port = svc_info->s_port;
     }
 
   s = connect_server (0);
   if (s < 0)
     report_file_error ("error creating socket", Fcons (name, Qnil));
-  send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port));
+  send_command (s, C_PORT, 0, "%s:%d", SDATA (host), ntohs (port));
   send_command (s, C_DUMB, 1, 0);
 
 #else  /* not TERM */
@@ -2694,7 +2760,7 @@ usage: (make-network-process &rest ARGS)  */)
       CHECK_STRING (service);
       bzero (&address_un, sizeof address_un);
       address_un.sun_family = AF_LOCAL;
-      strncpy (address_un.sun_path, XSTRING (service)->data, sizeof address_un.sun_path);
+      strncpy (address_un.sun_path, SDATA (service), sizeof address_un.sun_path);
       ai.ai_addr = (struct sockaddr *) &address_un;
       ai.ai_addrlen = sizeof address_un;
       goto open_socket;
@@ -2739,7 +2805,7 @@ usage: (make-network-process &rest ARGS)  */)
       else
        {
          CHECK_STRING (service);
-         portstring = XSTRING (service)->data;
+         portstring = SDATA (service);
        }
 
       immediate_quit = 1;
@@ -2749,12 +2815,12 @@ usage: (make-network-process &rest ARGS)  */)
       hints.ai_family = NILP (Fplist_member (contact, QCfamily)) ? AF_UNSPEC : family;
       hints.ai_socktype = socktype;
       hints.ai_protocol = 0;
-      ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
+      ret = getaddrinfo (SDATA (host), portstring, &hints, &res);
       if (ret)
 #ifdef HAVE_GAI_STRERROR
-       error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret));
+       error ("%s/%s %s", SDATA (host), portstring, gai_strerror(ret));
 #else
-        error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring, ret);
+        error ("%s/%s getaddrinfo error %d", SDATA (host), portstring, ret);
 #endif
       immediate_quit = 0;
 
@@ -2773,10 +2839,10 @@ usage: (make-network-process &rest ARGS)  */)
     {
       struct servent *svc_info;
       CHECK_STRING (service);
-      svc_info = getservbyname (XSTRING (service)->data
+      svc_info = getservbyname (SDATA (service)
                                (socktype == SOCK_DGRAM ? "udp" : "tcp"));
       if (svc_info == 0)
-       error ("Unknown service: %s", XSTRING (service)->data);
+       error ("Unknown service: %s", SDATA (service));
       port = svc_info->s_port;
     }
 
@@ -2794,7 +2860,7 @@ usage: (make-network-process &rest ARGS)  */)
         as it may `hang' emacs for a very long time.  */
       immediate_quit = 1;
       QUIT;
-      host_info_ptr = gethostbyname (XSTRING (host)->data);
+      host_info_ptr = gethostbyname (SDATA (host));
       immediate_quit = 0;
   
       if (host_info_ptr)
@@ -2808,9 +2874,9 @@ usage: (make-network-process &rest ARGS)  */)
        /* Attempt to interpret host as numeric inet address */
        {
          IN_ADDR numeric_addr;
-         numeric_addr = inet_addr ((char *) XSTRING (host)->data);
+         numeric_addr = inet_addr ((char *) SDATA (host));
          if (NUMERIC_ADDR_ERROR)
-           error ("Unknown host \"%s\"", XSTRING (host)->data);
+           error ("Unknown host \"%s\"", SDATA (host));
 
          bcopy ((char *)&numeric_addr, (char *) &address_in.sin_addr,
                 sizeof (address_in.sin_addr));
@@ -2843,7 +2909,7 @@ usage: (make-network-process &rest ARGS)  */)
     }
 
   /* Do this in case we never enter the for-loop below.  */
-  count1 = specpdl_ptr - specpdl;
+  count1 = SPECPDL_INDEX ();
   s = -1;
 
   for (lres = res; lres; lres = lres->ai_next)
@@ -3127,11 +3193,16 @@ usage: (make-network-process &rest ARGS)  */)
       val = Qnil;
     else
       {
-       args[0] = Qopen_network_stream, args[1] = name,
-         args[2] = buffer, args[3] = host, args[4] = service;
-       GCPRO1 (proc);
-       coding_systems = Ffind_operation_coding_system (5, args);
-       UNGCPRO;
+       if (NILP (host) || NILP (service))
+         coding_systems = Qnil;
+       else
+         {
+           args[0] = Qopen_network_stream, args[1] = name,
+             args[2] = buffer, args[3] = host, args[4] = service;
+           GCPRO1 (proc);
+           coding_systems = Ffind_operation_coding_system (5, args);
+           UNGCPRO;
+         }
        if (CONSP (coding_systems))
          val = XCAR (coding_systems);
        else if (CONSP (Vdefault_process_coding_system))
@@ -3151,11 +3222,16 @@ usage: (make-network-process &rest ARGS)  */)
       {
        if (EQ (coding_systems, Qt))
          {
-           args[0] = Qopen_network_stream, args[1] = name,
-             args[2] = buffer, args[3] = host, args[4] = service;
-           GCPRO1 (proc);
-           coding_systems = Ffind_operation_coding_system (5, args);
-           UNGCPRO;
+           if (NILP (host) || NILP (service))
+             coding_systems = Qnil;
+           else
+             {
+               args[0] = Qopen_network_stream, args[1] = name,
+                 args[2] = buffer, args[3] = host, args[4] = service;
+               GCPRO1 (proc);
+               coding_systems = Ffind_operation_coding_system (5, args);
+               UNGCPRO;
+             }
          }
        if (CONSP (coding_systems))
          val = XCDR (coding_systems);
@@ -3645,7 +3721,9 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
      HP-UX 10.10 seem to have problems with signals coming in
      Causes "poll: interrupted system call" messages when Emacs is run
      in an X window
-     Turn off periodic alarms (in case they are in use) */
+     Turn off periodic alarms (in case they are in use),
+     and then turn off any other atimers.  */
+  stop_polling ();
   turn_on_atimers (0);
 #endif
 
@@ -4283,7 +4361,7 @@ read_process_output (proc, channel)
          the tail of decoding buffer) should be prepended to the new
          data read to decode all together.  */
       chars = (char *) alloca (nbytes + carryover);
-      bcopy (XSTRING (p->decoding_buf)->data, buf, carryover);
+      bcopy (SDATA (p->decoding_buf), buf, carryover);
       bcopy (vs->inputBuffer, chars + carryover, nbytes);
     }
 #else /* not VMS */
@@ -4301,7 +4379,7 @@ read_process_output (proc, channel)
   chars = (char *) alloca (carryover + readmax);
   if (carryover)
     /* See the comment above.  */
-    bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
+    bcopy (SDATA (p->decoding_buf), chars, carryover);
 
 #ifdef DATAGRAM_SOCKETS
   /* We have a working select, so proc_buffered_char is always -1.  */
@@ -4348,7 +4426,7 @@ read_process_output (proc, channel)
       /* We inhibit quit here instead of just catching it so that 
         hitting ^G when a filter happens to be running won't screw
         it up.  */
-      int count = specpdl_ptr - specpdl;
+      int count = SPECPDL_INDEX ();
       Lisp_Object odeactivate;
       Lisp_Object obuffer, okeymap;
       Lisp_Object text;
@@ -4414,11 +4492,11 @@ read_process_output (proc, channel)
        }
 
       carryover = nbytes - coding->consumed;
-      bcopy (chars + coding->consumed, XSTRING (p->decoding_buf)->data,
+      bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
             carryover);
       XSETINT (p->decoding_carryover, carryover);
-      nbytes = STRING_BYTES (XSTRING (text));
-      nchars = XSTRING (text)->size;
+      nbytes = SBYTES (text);
+      nchars = SCHARS (text);
       if (nbytes > 0)
        internal_condition_case_1 (read_process_output_call,
                                   Fcons (outstream,
@@ -4515,7 +4593,7 @@ read_process_output (proc, channel)
            }
        }
       carryover = nbytes - coding->consumed;
-      bcopy (chars + coding->consumed, XSTRING (p->decoding_buf)->data,
+      bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
             carryover);
       XSETINT (p->decoding_carryover, carryover);
       /* Adjust the multibyteness of TEXT to that of the buffer.  */
@@ -4524,8 +4602,8 @@ read_process_output (proc, channel)
        text = (STRING_MULTIBYTE (text)
                ? Fstring_as_unibyte (text)
                : Fstring_as_multibyte (text));
-      nbytes = STRING_BYTES (XSTRING (text));
-      nchars = XSTRING (text)->size;
+      nbytes = SBYTES (text);
+      nchars = SCHARS (text);
       /* Insert before markers in case we are inserting where
         the buffer's mark is, and the user's next command is Meta-y.  */
       insert_from_string_before_markers (text, 0, 0, nchars, nbytes, 0);
@@ -4633,10 +4711,10 @@ send_process (proc, buf, len, object)
     update_status (XPROCESS (proc));
   if (! EQ (XPROCESS (proc)->status, Qrun))
     error ("Process %s not running",
-          XSTRING (XPROCESS (proc)->name)->data);
+          SDATA (XPROCESS (proc)->name));
   if (XINT (XPROCESS (proc)->outfd) < 0)
     error ("Output file descriptor of %s is closed",
-          XSTRING (XPROCESS (proc)->name)->data);
+          SDATA (XPROCESS (proc)->name));
 
   coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
   Vlast_coding_system_used = coding->symbol;
@@ -4691,7 +4769,7 @@ send_process (proc, buf, len, object)
        }
       else if (STRINGP (object))
        {
-         from_byte = buf - XSTRING (object)->data;
+         from_byte = buf - SDATA (object);
          from = string_byte_to_char (object, from_byte);
          to =  string_byte_to_char (object, from_byte + len);
        }
@@ -4704,19 +4782,19 @@ send_process (proc, buf, len, object)
            coding->composing = COMPOSITION_DISABLED;
        }
 
-      if (STRING_BYTES (XSTRING (XPROCESS (proc)->encoding_buf)) < require)
+      if (SBYTES (XPROCESS (proc)->encoding_buf) < require)
        XPROCESS (proc)->encoding_buf = make_uninit_string (require);
 
       if (from_byte >= 0)
        buf = (BUFFERP (object)
               ? BUF_BYTE_ADDRESS (XBUFFER (object), from_byte)
-              : XSTRING (object)->data + from_byte);
+              : SDATA (object) + from_byte);
 
       object = XPROCESS (proc)->encoding_buf;
-      encode_coding (coding, (char *) buf, XSTRING (object)->data,
-                    len, STRING_BYTES (XSTRING (object)));
+      encode_coding (coding, (char *) buf, SDATA (object),
+                    len, SBYTES (object));
       len = coding->produced;
-      buf = XSTRING (object)->data;
+      buf = SDATA (object);
       if (temp_buf)
        xfree (temp_buf);
     }
@@ -4849,7 +4927,7 @@ send_process (proc, buf, len, object)
                      if (BUFFERP (object))
                        offset = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
                      else if (STRINGP (object))
-                       offset = buf - XSTRING (object)->data;
+                       offset = buf - SDATA (object);
 
                      XSETFASTINT (zero, 0);
 #ifdef EMACS_HAS_USECS
@@ -4861,7 +4939,7 @@ send_process (proc, buf, len, object)
                      if (BUFFERP (object))
                        buf = BUF_BYTE_ADDRESS (XBUFFER (object), offset);
                      else if (STRINGP (object))
-                       buf = offset + XSTRING (object)->data;
+                       buf = offset + SDATA (object);
 
                      rv = 0;
                    }
@@ -4893,10 +4971,10 @@ send_process (proc, buf, len, object)
       deactivate_process (proc);
 #ifdef VMS
       error ("Error writing to process %s; closed it", 
-            XSTRING (XPROCESS (proc)->name)->data);
+            SDATA (XPROCESS (proc)->name));
 #else
       error ("SIGPIPE raised on process %s; closed it",
-            XSTRING (XPROCESS (proc)->name)->data);
+            SDATA (XPROCESS (proc)->name));
 #endif
     }
 
@@ -4946,8 +5024,8 @@ Output from processes can arrive in between bunches.  */)
   Lisp_Object proc;
   CHECK_STRING (string);
   proc = get_process (process);
-  send_process (proc, XSTRING (string)->data,
-               STRING_BYTES (XSTRING (string)), string);
+  send_process (proc, SDATA (string),
+               SBYTES (string), string);
   return Qnil;
 }
 \f
@@ -4970,10 +5048,10 @@ return t unconditionally.  */)
 
   if (!EQ (p->childp, Qt))
     error ("Process %s is not a subprocess",
-          XSTRING (p->name)->data);
+          SDATA (p->name));
   if (XINT (p->infd) < 0)
     error ("Process %s is not active",
-          XSTRING (p->name)->data);
+          SDATA (p->name));
 
 #ifdef TIOCGPGRP 
   if (!NILP (p->subtty))
@@ -5018,16 +5096,19 @@ process_send_signal (process, signo, current_group, nomsg)
 
   if (!EQ (p->childp, Qt))
     error ("Process %s is not a subprocess",
-          XSTRING (p->name)->data);
+          SDATA (p->name));
   if (XINT (p->infd) < 0)
     error ("Process %s is not active",
-          XSTRING (p->name)->data);
+          SDATA (p->name));
 
   if (NILP (p->pty_flag))
     current_group = Qnil;
 
   /* If we are using pgrps, get a pgrp number and make it negative.  */
-  if (!NILP (current_group))
+  if (NILP (current_group))
+    /* Send the signal to the shell's process group.  */
+    gid = XFASTINT (p->pid);
+  else
     {
 #ifdef SIGNALS_VIA_CHARACTERS
       /* If possible, send signals to the entire pgrp
@@ -5117,10 +5198,12 @@ process_send_signal (process, signo, current_group, nomsg)
 #endif /* ! defined (TCGETA) */
 #endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */
 #endif /* ! defined HAVE_TERMIOS */
-#endif /* ! defined (SIGNALS_VIA_CHARACTERS) */
+       abort ();
+      /* The code above always returns from the function.  */
+#endif /* defined (SIGNALS_VIA_CHARACTERS) */
 
 #ifdef TIOCGPGRP 
-      /* Get the pgrp using the tty itself, if we have that.
+      /* Get the current pgrp using the tty itself, if we have that.
         Otherwise, use the pty to get the pgrp.
         On pfa systems, saka@pfu.fujitsu.co.JP writes:
         "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
@@ -5135,28 +5218,28 @@ process_send_signal (process, signo, current_group, nomsg)
        else
          err = ioctl (XINT (p->infd), TIOCGPGRP, &gid);
 
-#ifdef pfa
        if (err == -1)
-         gid = - XFASTINT (p->pid);
-#endif /* ! defined (pfa) */
+         /* If we can't get the information, assume
+            the shell owns the tty.  */
+         gid = XFASTINT (p->pid);
       }
+
+      /* It is not clear whether anything really can set GID to -1.
+        Perhaps on some system one of those ioctls can or could do so.
+        Or perhaps this is vestigial.  */
       if (gid == -1)
        no_pgrp = 1;
-      else
-       gid = - gid;
 #else  /* ! defined (TIOCGPGRP ) */
       /* Can't select pgrps on this system, so we know that
         the child itself heads the pgrp.  */
-      gid = XFASTINT (p->pid);
+      gid = XFASTINT (p->pid);
 #endif /* ! defined (TIOCGPGRP ) */
 
       /* If current_group is lambda, and the shell owns the terminal,
         don't send any signal.  */
-      if (EQ (current_group, Qlambda) && gid == XFASTINT (p->pid))
+      if (EQ (current_group, Qlambda) && gid == XFASTINT (p->pid))
        return;
     }
-  else
-    gid = - XFASTINT (p->pid);
 
   switch (signo)
     {
@@ -5208,7 +5291,7 @@ process_send_signal (process, signo, current_group, nomsg)
       kill (gid, signo);
     }
 #else /* ! defined (TIOCSIGSEND) */
-  EMACS_KILLPG (-gid, signo);
+  EMACS_KILLPG (gid, signo);
 #endif /* ! defined (TIOCSIGSEND) */
 }
 
@@ -5315,14 +5398,46 @@ If PROCESS is a network process, resume handling of incoming traffic.  */)
 }
 
 DEFUN ("signal-process", Fsignal_process, Ssignal_process,
-       2, 2, "nProcess number: \nnSignal code: ",
-       doc: /* Send the process with process id PID the signal with code SIGCODE.
-PID must be an integer.  The process need not be a child of this Emacs.
+       2, 2, "sProcess (name or number): \nnSignal code: ",
+       doc: /* Send PROCESS the signal with code SIGCODE.
+PROCESS may also be an integer specifying the process id of the
+process to signal; in this case, the process need not be a child of
+this Emacs.
 SIGCODE may be an integer, or a symbol whose name is a signal name.  */)
-     (pid, sigcode)
-     Lisp_Object pid, sigcode;
+     (process, sigcode)
+     Lisp_Object process, sigcode;
 {
-  CHECK_NUMBER (pid);
+  Lisp_Object pid;
+
+  if (INTEGERP (process))
+    {
+      pid = process;
+      goto got_it;
+    }
+
+  if (STRINGP (process))
+    {
+      Lisp_Object tem;
+      if (tem = Fget_process (process), NILP (tem))
+       {
+         pid = Fstring_to_number (process, make_number (10));
+         if (XINT (pid) != 0)
+           goto got_it;
+       }
+      process = tem;
+    }
+  else
+    process = get_process (process);
+      
+  if (NILP (process))
+    return process;
+
+  CHECK_PROCESS (process);
+  pid = XPROCESS (process)->pid;
+  if (!INTEGERP (pid) || XINT (pid) <= 0)
+    error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
+
+ got_it:
 
 #define handle_signal(NAME, VALUE)             \
   else if (!strcmp (name, NAME))               \
@@ -5335,7 +5450,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name.  */)
       unsigned char *name;
 
       CHECK_SYMBOL (sigcode);
-      name = XSYMBOL (sigcode)->name->data;
+      name = SDATA (SYMBOL_NAME (sigcode));
 
       if (0)
        ;
@@ -5462,7 +5577,7 @@ text to PROCESS after you call this function.  */)
   if (! NILP (XPROCESS (proc)->raw_status_low))
     update_status (XPROCESS (proc));
   if (! EQ (XPROCESS (proc)->status, Qrun))
-    error ("Process %s not running", XSTRING (XPROCESS (proc)->name)->data);
+    error ("Process %s not running", SDATA (XPROCESS (proc)->name));
 
   if (CODING_REQUIRE_FLUSHING (coding))
     {
@@ -5734,7 +5849,7 @@ exec_sentinel (proc, reason)
 {
   Lisp_Object sentinel, obuffer, odeactivate, okeymap;
   register struct Lisp_Process *p = XPROCESS (proc);
-  int count = specpdl_ptr - specpdl;
+  int count = SPECPDL_INDEX ();
   int outer_running_asynch_code = running_asynch_code;
   int waiting = waiting_for_user_input_p;
 
@@ -5944,9 +6059,9 @@ encode subprocess input.  */)
   CHECK_PROCESS (proc);
   p = XPROCESS (proc);
   if (XINT (p->infd) < 0)
-    error ("Input file descriptor of %s closed", XSTRING (p->name)->data);
+    error ("Input file descriptor of %s closed", SDATA (p->name));
   if (XINT (p->outfd) < 0)
-    error ("Output file descriptor of %s closed", XSTRING (p->name)->data);
+    error ("Output file descriptor of %s closed", SDATA (p->name));
 
   p->decode_coding_system = Fcheck_coding_system (decoding);
   p->encode_coding_system = Fcheck_coding_system (encoding);
@@ -6218,6 +6333,7 @@ The value takes effect when `start-process' is called.  */);
 #ifdef HAVE_SOCKETS
   defsubr (&Sset_network_process_options);
   defsubr (&Smake_network_process);
+  defsubr (&Sformat_network_address);
 #endif /* HAVE_SOCKETS */
 #ifdef DATAGRAM_SOCKETS
   defsubr (&Sprocess_datagram_address);
@@ -6314,7 +6430,9 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
     }
 
   /* Turn off periodic alarms (in case they are in use)
+     and then turn off any other atimers,
      because the select emulator uses alarms.  */
+  stop_polling ();
   turn_on_atimers (0);
 
   while (1)