X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1f924f9953d39e0a8bf9924ccef0b0411a756572..8bae7480b8bfe970f97e6afbb919ca41c28397f0:/src/vmsproc.c diff --git a/src/vmsproc.c b/src/vmsproc.c index ec9678f78a..c229a914bd 100644 --- a/src/vmsproc.c +++ b/src/vmsproc.c @@ -1,11 +1,11 @@ /* 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 -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, @@ -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 -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 */ +#include #include #include #include #include #include "vmsproc.h" +#include "lisp.h" +#include "buffer.h" +#include +#include "process.h" +#include "commands.h" +#include +extern Lisp_Object call_process_cleanup (); + #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); } - len =- out; + len -= out; } return (1); } @@ -393,7 +403,7 @@ child_setup (in, out, err, new_argv, env) close_process_descs (); #endif - if (XTYPE (current_buffer->directory) == Lisp_String) + if (STRINGP (current_buffer->directory)) chdir (XSTRING (current_buffer->directory)->data); } @@ -437,7 +447,7 @@ if you quit, the process is killed.") 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); @@ -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); - if (XTYPE (buffer) == Lisp_Int) + if (INTEGERP (buffer)) { 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 */ - if (XTYPE (buffer) != Lisp_Int) + if (!INTEGERP (buffer)) { start_vms_process_read (vs); SpawnFlags = CLI$M_NOWAIT; @@ -565,7 +575,7 @@ if you quit, the process is killed.") } pid = vs->pid; - if (XTYPE (buffer) == Lisp_Int) + if (INTEGERP (buffer)) { #ifndef subprocesses wait_without_blocking (); @@ -573,11 +583,14 @@ if you quit, the process is killed.") return Qnil; } + if (!NILP (display) && INTERACTIVE) + prepare_menu_bars (); + 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; @@ -589,12 +602,12 @@ if you quit, the process is killed.") 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]); } - if (!NULL (display) && INTERACTIVE) + if (!NILP (display) && INTERACTIVE) redisplay_preserve_echo_area (); immediate_quit = 1; QUIT; @@ -604,9 +617,10 @@ if you quit, the process is killed.") 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); @@ -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, - 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; - 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 */ @@ -729,7 +743,7 @@ create_process (process, new_argv) */ write_to_vms_process (vs, NO_ECHO, strlen (NO_ECHO)); - XFASTINT (XPROCESS (process)->pid) = pid; + XSETFASTINT (XPROCESS (process)->pid, pid); sys$setast (1); } @@ -755,10 +769,7 @@ child_sig (vs) 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 ()