pty.tcl

pty.tcl - a tcl extension for Posix pty support using critcl - CMcC 18May2012
- a sloppy job, but it's a start
# pty - an extension to provide Posix pty support to Tcl
package provide Pty 1.0


if {[info commands ::_pty] ne ""} {
    # pty - create a pty
    # returns an open chan for the master pty, and the file name of the associated slave pty
    #
    # args to pty are in the form of a dict such that:
    #        rdwr $rdwr - boolean to indicate that the pty is (or is not) readable and writable
    #        noctty $noctty - boolean to indicate that the pty is not the controlling terminal for this process
    #
    proc pty {args} {
        set rdwr 1
        set noctty 1
        dict with args {}
        return [_pty $rdwr $noctty]
    }
    return
}

package require critcl
::critcl::tsources pty.tcl

critcl::ccode {
    #include <stdlib.h>
    #include <fcntl.h>
    #include <tcl.h>
    #include <errno.h>
    #include <stdio.h>
}

critcl::cproc _pty {Tcl_Interp* interp int rdwr int noctty} ok {
    int master;
    static int pty_count = 0;
    char slave[256];
    Tcl_Channel masterC;
    char masterChan[64];
    Tcl_Obj *result;
    Tcl_ChannelType *chanTypePtr;
    int flags = 0;

    if (rdwr) {
        flags |= O_RDWR;
    }
    if (noctty) {
        flags |= O_NOCTTY;
    }

    master = posix_openpt(flags);
    if (master < 0) {
        Tcl_AppendResult(interp,
                         "open pty failed \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"",
                         (char *) NULL);
        return TCL_ERROR;
    }

    if (ptsname_r(master, slave, sizeof(slave)) < 0) {
        Tcl_AppendResult(interp,
                         "ptsname failed \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"",
                         (char *) NULL);
        return TCL_ERROR;
    }

    masterC = Tcl_MakeFileChannel(master,TCL_READABLE | TCL_WRITABLE);
    if (masterC == (Tcl_Channel)NULL) {
        return TCL_ERROR;
    }

    /*fprintf(stderr, "master: %x\n", masterC);*/
    Tcl_RegisterChannel(interp, masterC);

    result = Tcl_NewListObj(0, NULL);

    Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(Tcl_GetChannelName(masterC), -1));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(slave, -1));
    Tcl_SetObjResult(interp, result);

    return TCL_OK;
}
Enter Category Here