pty.tcl - a tcl extension for Posix pty support using critcl ====== # pty - an extension to provide Posix pty support to Tcl package provide Pty 1.0 if {[info commands ::_pty] ne ""} { 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 #include #include #include #include } 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