Moved set/get tty process group code to tty.scm.

Added open-control-tty.

scsh/tty.c

@@ -6,6 +6,7 @@
 #include <stdlib.h> /* For malloc. */
 #include "libcig.h"
 
+#include <unistd.h>
 #include <termios.h>
 
 /* Make sure foreign-function stubs interface to the C funs correctly: */
@@ -106,3 +107,41 @@ scheme_value df_tcflow(long nargs, scheme_value *args)
     return ret1;
     }
 
+scheme_value df_tcsetpgrp(long nargs, scheme_value *args)
+{
+    extern int tcsetpgrp(int , pid_t );
+    scheme_value ret1;
+    int r1;
+
+    cig_check_nargs(2, nargs, "tcsetpgrp");
+    r1 = tcsetpgrp(EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0]));
+    ret1 = errno_or_false(r1);
+    return ret1;
+    }
+
+scheme_value df_tcgetpgrp(long nargs, scheme_value *args)
+{
+    extern pid_t tcgetpgrp(int );
+    scheme_value ret1;
+    pid_t r1;
+
+    cig_check_nargs(2, nargs, "tcgetpgrp");
+    r1 = tcgetpgrp(EXTRACT_FIXNUM(args[1]));
+    ret1 = errno_or_false(r1);
+    VECTOR_REF(*args,0) = ENTER_FIXNUM(r1);
+    return ret1;
+    }
+
+scheme_value df_open_ctty(long nargs, scheme_value *args)
+{
+    extern int open_ctty(const char *, int );
+    scheme_value ret1;
+    int r1;
+
+    cig_check_nargs(3, nargs, "open_ctty");
+    r1 = open_ctty(cig_string_body(args[2]), EXTRACT_FIXNUM(args[1]));
+    ret1 = errno_or_false(r1);
+    VECTOR_REF(*args,0) = ENTER_FIXNUM(r1);
+    return ret1;
+    }
+

scsh/tty.scm

@@ -14,6 +14,7 @@
 ;;; Rehacked by Olin 8/95.
 
 (foreign-source
+ "#include <unistd.h>"
  "#include <termios.h>"
  ""
  "/* Make sure foreign-function stubs interface to the C funs correctly: */"
@@ -280,3 +281,59 @@
 
 (define (decode-baud-rate code)		; value of BAUD/9600 -> 9600
   (car (vector-ref baud-rates code)))
+
+
+;;; Set/Get tty process group
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (set-tty-process-group port/fd proc-group)
+  (call/fdes port/fd
+    (lambda (fd)
+      (%set-tty-process-group fd (if (integer? proc-group)
+				     proc-group
+				     (proc:pid proc-group))))))
+
+(define-simple-errno-syscall (%set-tty-process-group fdes pid)
+  %set-tty-process-group/errno)
+
+(define-foreign %set-tty-process-group/errno (tcsetpgrp (fixnum fdes)
+						        (pid_t pid))
+  (to-scheme integer errno_or_false))
+
+(define (tty-process-group port/fd)
+  (call/fdes port/fd %tty-process-group))
+
+(define-errno-syscall (%tty-process-group fd) %tty-process-group/errno
+  pid)
+
+(define-foreign %tty-process-group/errno (tcgetpgrp (fixnum fdes))
+  (multi-rep (to-scheme pid_t errno_or_false)
+             pid_t))
+
+;;; (open-control-tty fname [flags])
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Open a control tty, return a port.
+;;; This procedure is only guaranteed to work when the process doesn't already
+;;; have a control tty -- e.g., right after a (BECOME-PROCESS-LEADER) call.
+;;; This limted functionality is about all we can provide portably across BSD,
+;;; SunOS, and SVR4.
+
+(define (open-control-tty ttyname maybe-flags)
+  (let ((flags (optional-arg maybe-flags open/read+write)))
+    (receive (errno fd) (open-control-tty/errno ttyname flags)
+      (if errno
+	  (errno-error errno open-control-tty ttyname flags)
+
+	  (let* ((access (bitwise-and flags open/access-mask))
+		 (port ((if (or (= access open/read) (= access open/read+write))
+			    make-input-fdport
+			    make-output-fdport)
+			fd)))
+	    (%install-port fd port)
+	    port)))))
+
+(define-foreign open-control-tty/errno (open_ctty (string ttyname)
+						  (fixnum flags))
+  (multi-rep (to-scheme integer errno_or_false)
+             integer))
+