]> code.delx.au - gnu-emacs/blobdiff - src/vmsproc.c
(ad-make-single-advice-docstring): Treat case with no doctring specially.
[gnu-emacs] / src / vmsproc.c
index ec9678f78a44e11f57cbcca05caf1a56c97329d2..c229a914bd315018822f9c5324ec92d5d4a24821 100644 (file)
@@ -1,11 +1,11 @@
 /* Interfaces to subprocesses on VMS.
 /* Interfaces to subprocesses on VMS.
-   Copyright (C) 1988 Free Software Foundation, Inc.
+   Copyright (C) 1988, 1994 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
 GNU Emacs is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
 
 This file is part of GNU Emacs.
 
 GNU Emacs is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 1, or (at your option)
+the Free Software Foundation; either version 2, or (at your option)
 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
@@ -15,7 +15,8 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
-the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
 
 
 /*
 
 
 /*
@@ -26,11 +27,20 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
     23 is the timer event flag
     24-31 are reserved by VMS
 */
     23 is the timer event flag
     24-31 are reserved by VMS
 */
+#include <config.h>
 #include       <ssdef.h>
 #include       <iodef.h>
 #include       <dvidef.h>
 #include       <clidef.h>
 #include       "vmsproc.h"
 #include       <ssdef.h>
 #include       <iodef.h>
 #include       <dvidef.h>
 #include       <clidef.h>
 #include       "vmsproc.h"
+#include       "lisp.h"
+#include       "buffer.h"
+#include       <file.h>
+#include       "process.h"
+#include       "commands.h"
+#include       <errno.h>
+extern Lisp_Object call_process_cleanup ();
+
 
 #define                KEYBOARD_EVENT_FLAG             1
 #define                TIMER_EVENT_FLAG                23
 
 #define                KEYBOARD_EVENT_FLAG             1
 #define                TIMER_EVENT_FLAG                23
@@ -241,7 +251,7 @@ write_to_vms_process (vs, buf, len)
          error ("Could not write to subprocess: %x", status);
          return (0);
        }
          error ("Could not write to subprocess: %x", status);
          return (0);
        }
-      len =- out;
+      len -= out;
     }
   return (1);
 }
     }
   return (1);
 }
@@ -393,7 +403,7 @@ child_setup (in, out, err, new_argv, env)
   close_process_descs ();
 #endif
 
   close_process_descs ();
 #endif
 
-  if (XTYPE (current_buffer->directory) == Lisp_String)
+  if (STRINGP (current_buffer->directory))
     chdir (XSTRING (current_buffer->directory)->data);
 }
 
     chdir (XSTRING (current_buffer->directory)->data);
 }
 
@@ -437,7 +447,7 @@ if you quit, the process is killed.")
 
   CHECK_STRING (args[0], 0);
 
 
   CHECK_STRING (args[0], 0);
 
-  if (nargs <= 1 || NULL (args[1]))
+  if (nargs <= 1 || NILP (args[1]))
     args[1] = build_string ("NLA0:");
   else
     args[1] = Fexpand_file_name (args[1], current_buffer->directory);
     args[1] = build_string ("NLA0:");
   else
     args[1] = Fexpand_file_name (args[1], current_buffer->directory);
@@ -497,7 +507,7 @@ if you quit, the process is killed.")
     status = get_pty_channel (inDevName, outDevName, &inchannel, &outchannel);
     if (!(status & 1))
       error ("Error getting PTY channel: %x", status);
     status = get_pty_channel (inDevName, outDevName, &inchannel, &outchannel);
     if (!(status & 1))
       error ("Error getting PTY channel: %x", status);
-    if (XTYPE (buffer) == Lisp_Int)
+    if (INTEGERP (buffer))
       {
        dout.l = strlen ("NLA0:");
        dout.a = "NLA0:";
       {
        dout.l = strlen ("NLA0:");
        dout.a = "NLA0:";
@@ -536,7 +546,7 @@ if you quit, the process is killed.")
   /*
       Start a read on the process channel
   */
   /*
       Start a read on the process channel
   */
-  if (XTYPE (buffer) != Lisp_Int)
+  if (!INTEGERP (buffer))
     {
       start_vms_process_read (vs);
       SpawnFlags = CLI$M_NOWAIT;
     {
       start_vms_process_read (vs);
       SpawnFlags = CLI$M_NOWAIT;
@@ -565,7 +575,7 @@ if you quit, the process is killed.")
     }
   pid = vs->pid;
 
     }
   pid = vs->pid;
 
-  if (XTYPE (buffer) == Lisp_Int)
+  if (INTEGERP (buffer))
     {
 #ifndef subprocesses
       wait_without_blocking ();
     {
 #ifndef subprocesses
       wait_without_blocking ();
@@ -573,11 +583,14 @@ if you quit, the process is killed.")
       return Qnil;
     }
 
       return Qnil;
     }
 
+  if (!NILP (display) && INTERACTIVE)
+    prepare_menu_bars ();
+
   record_unwind_protect (call_process_cleanup,
                         Fcons (make_number (fd[0]), make_number (pid)));
 
 
   record_unwind_protect (call_process_cleanup,
                         Fcons (make_number (fd[0]), make_number (pid)));
 
 
-  if (XTYPE (buffer) == Lisp_Buffer)
+  if (BUFFERP (buffer))
     Fset_buffer (buffer);
 
   immediate_quit = 1;
     Fset_buffer (buffer);
 
   immediate_quit = 1;
@@ -589,12 +602,12 @@ if you quit, the process is killed.")
       if (vs->iosb[0] & 1)
        {
          immediate_quit = 0;
       if (vs->iosb[0] & 1)
        {
          immediate_quit = 0;
-         if (!NULL (buffer))
+         if (!NILP (buffer))
            {
              vs->iosb[1] = clean_vms_buffer (vs->inputBuffer, vs->iosb[1]);
              InsCStr (vs->inputBuffer, vs->iosb[1]);
            }
            {
              vs->iosb[1] = clean_vms_buffer (vs->inputBuffer, vs->iosb[1]);
              InsCStr (vs->inputBuffer, vs->iosb[1]);
            }
-         if (!NULL (display) && INTERACTIVE)
+         if (!NILP (display) && INTERACTIVE)
          redisplay_preserve_echo_area ();
          immediate_quit = 1;
          QUIT;
          redisplay_preserve_echo_area ();
          immediate_quit = 1;
          QUIT;
@@ -604,9 +617,10 @@ if you quit, the process is killed.")
       else
        break;
     }
       else
        break;
     }
-    sys$dassgn (inchannel);
-    sys$dassgn (outchannel);
-    give_back_vms_process_stuff (vs);
+
+  sys$dassgn (inchannel);
+  sys$dassgn (outchannel);
+  give_back_vms_process_stuff (vs);
 
   /* Wait for it to terminate, unless it already has.  */
   wait_for_termination (pid);
 
   /* Wait for it to terminate, unless it already has.  */
   wait_for_termination (pid);
@@ -706,16 +720,16 @@ create_process (process, new_argv)
     
     Event flags returned start at 1 for the keyboard.
     Since Unix expects descriptor 0 for the keyboard,
     
     Event flags returned start at 1 for the keyboard.
     Since Unix expects descriptor 0 for the keyboard,
-    we substract one from the event flag.
+    we subtract one from the event flag.
     */
   inchannel = vs->eventFlag-1;
 
   /* Record this as an active process, with its channels.
      As a result, child_setup will close Emacs's side of the pipes.  */
   chan_process[inchannel] = process;
     */
   inchannel = vs->eventFlag-1;
 
   /* Record this as an active process, with its channels.
      As a result, child_setup will close Emacs's side of the pipes.  */
   chan_process[inchannel] = process;
-  XFASTINT (XPROCESS (process)->infd) = inchannel;
-  XFASTINT (XPROCESS (process)->outfd) = outchannel;
-  XFASTINT (XPROCESS (process)->flags) = RUNNING;
+  XSETFASTINT (XPROCESS (process)->infd, inchannel);
+  XSETFASTINT (XPROCESS (process)->outfd, outchannel);
+  XPROCESS (process)->status = Qrun
 
   /* Delay interrupts until we have a chance to store
      the new fork's pid in its process structure */
 
   /* Delay interrupts until we have a chance to store
      the new fork's pid in its process structure */
@@ -729,7 +743,7 @@ create_process (process, new_argv)
     */
   write_to_vms_process (vs, NO_ECHO, strlen (NO_ECHO));
 
     */
   write_to_vms_process (vs, NO_ECHO, strlen (NO_ECHO));
 
-  XFASTINT (XPROCESS (process)->pid) = pid;
+  XSETFASTINT (XPROCESS (process)->pid, pid);
   sys$setast (1);
 }
 
   sys$setast (1);
 }
 
@@ -755,10 +769,7 @@ child_sig (vs)
   if (XSYMBOL (tail) == XSYMBOL (Qnil))
     return;
 
   if (XSYMBOL (tail) == XSYMBOL (Qnil))
     return;
 
-  child_changed++;
-  XFASTINT (p->flags) = EXITED | CHANGED;
-  /* Truncate the exit status to 24 bits so that it fits in a FASTINT */
-  XFASTINT (p->reason) = (vs->exitStatus) & 0xffffff;
+  p->status = Fcons (Qexit, Fcons (make_number (vs->exitStatus), Qnil))
 }
 
 syms_of_vmsproc ()
 }
 
 syms_of_vmsproc ()