Index: doc/open.n ================================================================== --- doc/open.n +++ doc/open.n @@ -164,12 +164,13 @@ If \fIfileName\fR refers to a serial port, then the specified serial port is opened and initialized in a platform-dependent manner. Acceptable values for the \fIfileName\fR to use to open a serial port are described in the PORTABILITY ISSUES section. .PP -The \fBfconfigure\fR command can be used to query and set additional -configuration options specific to serial ports (where supported): +The \fBchan configure\fR and \fBfconfigure\fR commands can be used to query +and set additional configuration options specific to serial ports (where +supported): .TP \fB\-mode\fR \fIbaud\fB,\fIparity\fB,\fIdata\fB,\fIstop\fR . This option is a set of 4 comma-separated values: the baud rate, parity, number of data bits, and number of stop bits for this serial port. The @@ -246,10 +247,79 @@ . (Windows and Unix). This option is used to query or change the software handshake characters. Normally the operating system default should be DC1 (0x11) and DC3 (0x13) representing the ASCII standard XON and XOFF characters. +.TP +\fB\-closemode\fR \fIcloseMode\fR +.VS "8.7, TIP 160" +(Windows and Unix). This option is used to query or change the close mode of +the serial channel, which defines how pending output in operating system +buffers is handled when the channel is closed. The following values for +\fIcloseMode\fR are supported: +.RS +.TP +\fBdefault\fR +. +indicates that a system default operation should be used; all serial channels +default to this. +.TP +\fBdiscard\fR +. +indicates that the contents of the OS buffers should be discarded. Note that +this is \fInot recommended\fR when writing to a POSIX terminal, as it can +interact unexpectedly with handling of \fBstderr\fR. +.TP +\fBdrain\fR +. +indicates that Tcl should wait when closing the channel until all output has +been consumed. This may slow down \fBclose\fR noticeably. +.RE +.VE "8.7, TIP 160" +.TP +\fB\-inputmode\fR \fIinputMode\fR +.VS "8.7, TIP 160" +(Unix only; Windows has the equivalent option on console channels). This +option is used to query or change the input mode of the serial channel under +the assumption that it is talking to a terminal, which controls how interactive +input from users is handled. The following values for \fIinputMode\fR are +supported: +.RS +.TP +\fBnormal\fR +. +indicates that normal line-oriented input should be used, with standard +terminal editing capabilities enabled. +.TP +\fBpassword\fR +. +indicates that non-echoing input should be used, with standard terminal +editing capabilities enabled but no writing of typed characters to the +terminal (except for newlines). Some terminals may indicate this specially. +.TP +\fBraw\fR +. +indicates that all keyboard input should be given directly to Tcl with the +terminal doing no processing at all. It does not echo the keys, leaving it up +to the Tcl script to interpret what to do. +.TP +\fBreset\fR (set only) +. +indicates that the terminal should be reset to what state it was in when the +terminal was opened. +.PP +Note that setting this option (technically, anything that changes the terminal +state from its initial value \fIvia this option\fR) will cause the channel to +turn on an automatic reset of the terminal when the channel is closed. +.RE +.TP +\fB\-winsize\fR +. +(Unix only; Windows has the equivalent option on console channels). This +option is query only. It retrieves a two-element list with the the current +width and height of the terminal. +.VE "8.7, TIP 160" .TP \fB\-pollinterval\fR \fImsec\fR . (Windows only). This option is used to set the maximum time between polling for fileevents. @@ -273,11 +343,11 @@ (Windows only). This option is query only. In case of a serial communication error, \fBread\fR or \fBputs\fR returns a general Tcl file I/O error. \fBfconfigure\fR \fB\-lasterror\fR can be called to get a list of error details. See below for an explanation of the various error codes. -.SH "SERIAL PORT SIGNALS" +.SS "SERIAL PORT SIGNALS" .PP RS-232 is the most commonly used standard electrical interface for serial communications. A negative voltage (-3V..-12V) define a mark (on=1) bit and a positive voltage (+3..+12V) define a space (off=0) bit (RS-232C). The following signals are specified for incoming and outgoing data, status @@ -314,11 +384,11 @@ TXD or RXD lines for a long period of time, usually 250 to 500 milliseconds. Normally a receive or transmit data signal stays at the mark (on=1) voltage until the next character is transferred. A BREAK is sometimes used to reset the communications line or change the operating mode of communications hardware. -.SH "ERROR CODES (Windows only)" +.SS "ERROR CODES (Windows only)" .PP A lot of different errors may occur during serial read operations or during event polling in background. The external device may have been switched off, the data lines may be noisy, system buffers may overrun or your mode settings may be wrong. That is why a reliable software should always @@ -357,11 +427,11 @@ may cause this error. .TP 10 \fBBREAK\fR . A BREAK condition has been detected by your UART (see above). -.SH "PORTABILITY ISSUES" +.SS "PORTABILITY ISSUES" .TP \fBWindows \fR . Valid values for \fIfileName\fR to open a serial port are of the form \fBcom\fIX\fB\fR, where \fIX\fR is a number, generally from 1 to 9. @@ -406,11 +476,59 @@ .RE .PP See the \fBPORTABILITY ISSUES\fR section of the \fBexec\fR command for additional information not specific to command pipelines about executing applications on the various platforms -.SH "EXAMPLE" +.SH "CONSOLE CHANNELS" +.VS "8.7, TIP 160" +On Windows only, console channels (usually \fBstdin\fR or \fBstdout\fR) +support the following options: +.TP +\fB\-inputmode\fR \fIinputMode\fR +. +This option is used to query or change the input mode of the console channel, +which controls how interactive input from users is handled. The following +values for \fIinputMode\fR are supported: +.RS +.TP +\fBnormal\fR +. +indicates that normal line-oriented input should be used, with standard +console editing capabilities enabled. +.TP +\fBpassword\fR +. +indicates that non-echoing input should be used, with standard console +editing capabilitied enabled but no writing of typed characters to the +terminal (except for newlines). +.TP +\fBraw\fR +. +indicates that all keyboard input should be given directly to Tcl with the +console doing no processing at all. It does not echo the keys, leaving it up +to the Tcl script to interpret what to do. +.TP +\fBreset\fR (set only) +. +indicates that the console should be reset to what state it was in when the +console channel was opened. +.PP +Note that setting this option (technically, anything that changes the console +state from its default \fIvia this option\fR) will cause the channel to turn +on an automatic reset of the console when the channel is closed. +.RE +.TP +\fB\-winsize\fR +. +This option is query only. +It retrieves a two-element list with the the current width and height of the +console that this channel is talking to. +.PP +Note that the equivalent options exist on Unix, but are on the serial channel +type. +.VE "8.7, TIP 160" +.SH "EXAMPLES" .PP Open a command pipeline and catch any errors: .PP .CS set fl [\fBopen\fR "| ls this_file_does_not_exist"] @@ -417,14 +535,30 @@ set data [read $fl] if {[catch {close $fl} err]} { puts "ls command failed: $err" } .CE +.PP +.VS "8.7, TIP 160" +Read a password securely from the user (assuming that the script is being run +interactively): +.PP +.CS +chan configure stdin \fB-inputmode password\fR +try { + chan puts -nonewline "Password: " + chan flush stdout + set thePassword [chan gets stdin] +} finally { + chan configure stdin \fB-inputmode reset\fR +} +.CE +.VE "8.7, TIP 160" .SH "SEE ALSO" file(n), close(n), filename(n), fconfigure(n), gets(n), read(n), puts(n), exec(n), pid(n), fopen(3) .SH KEYWORDS access mode, append, create, file, non-blocking, open, permissions, pipeline, process, serial '\"Local Variables: '\"mode: nroff '\"End: Index: tests/ioCmd.test ================================================================== --- tests/ioCmd.test +++ tests/ioCmd.test @@ -204,82 +204,94 @@ chan close $chan write } -cleanup { close $chan } -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed" -test iocmd-8.1 {fconfigure command} { - list [catch {fconfigure} msg] $msg -} {1 {wrong # args: should be "fconfigure channelId ?-option value ...?"}} -test iocmd-8.2 {fconfigure command} { - list [catch {fconfigure a b c d e f} msg] $msg -} {1 {wrong # args: should be "fconfigure channelId ?-option value ...?"}} -test iocmd-8.3 {fconfigure command} { - list [catch {fconfigure a b} msg] $msg -} {1 {can not find channel named "a"}} -test iocmd-8.4 {fconfigure command} { +proc expectedOpts {got extra} { + set basicOpts { + -blocking -buffering -buffersize -encoding -eofchar -translation + } + set opts [list {*}$basicOpts {*}$extra] + lset opts end [string cat "or " [lindex $opts end]] + return [format {bad option "%s": should be one of %s} $got [join $opts ", "]] +} +test iocmd-8.1 {fconfigure command} -returnCodes error -body { + fconfigure +} -result {wrong # args: should be "fconfigure channelId ?-option value ...?"} +test iocmd-8.2 {fconfigure command} -returnCodes error -body { + fconfigure a b c d e f +} -result {wrong # args: should be "fconfigure channelId ?-option value ...?"} +test iocmd-8.3 {fconfigure command} -returnCodes error -body { + fconfigure a b +} -result {can not find channel named "a"} +test iocmd-8.4 {fconfigure command} -setup { file delete $path(test1) set f1 [open $path(test1) w] - set x [list [catch {fconfigure $f1 froboz} msg] $msg] +} -body { + fconfigure $f1 froboz +} -returnCodes error -cleanup { close $f1 - set x -} {1 {bad option "froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}} -test iocmd-8.5 {fconfigure command} { - list [catch {fconfigure stdin -buffering froboz} msg] $msg -} {1 {bad value for -buffering: must be one of full, line, or none}} -test iocmd-8.6 {fconfigure command} { - list [catch {fconfigure stdin -translation froboz} msg] $msg -} {1 {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}} -test iocmd-8.7 {fconfigure command} { +} -result [expectedOpts "froboz" {}] +test iocmd-8.5 {fconfigure command} -returnCodes error -body { + fconfigure stdin -buffering froboz +} -result {bad value for -buffering: must be one of full, line, or none} +test iocmd-8.6 {fconfigure command} -returnCodes error -body { + fconfigure stdin -translation froboz +} -result {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform} +test iocmd-8.7 {fconfigure command} -setup { file delete $path(test1) +} -body { set f1 [open $path(test1) w] fconfigure $f1 -translation lf -eofchar {} -encoding unicode - set x [fconfigure $f1] - close $f1 - set x -} {-blocking 1 -buffering full -buffersize 4096 -encoding unicode -eofchar {} -translation lf} -test iocmd-8.8 {fconfigure command} { + fconfigure $f1 +} -cleanup { + catch {close $f1} +} -result {-blocking 1 -buffering full -buffersize 4096 -encoding unicode -eofchar {} -translation lf} +test iocmd-8.8 {fconfigure command} -setup { file delete $path(test1) + set x {} +} -body { set f1 [open $path(test1) w] fconfigure $f1 -translation lf -buffering line -buffersize 3030 \ -eofchar {} -encoding unicode - set x "" lappend x [fconfigure $f1 -buffering] lappend x [fconfigure $f1] - close $f1 - set x -} {line {-blocking 1 -buffering line -buffersize 3030 -encoding unicode -eofchar {} -translation lf}} -test iocmd-8.9 {fconfigure command} { +} -cleanup { + catch {close $f1} +} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding unicode -eofchar {} -translation lf}} +test iocmd-8.9 {fconfigure command} -setup { file delete $path(test1) +} -body { set f1 [open $path(test1) w] fconfigure $f1 -translation binary -buffering none -buffersize 4040 \ -eofchar {} -encoding binary - set x [fconfigure $f1] - close $f1 - set x -} {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -translation lf} -test iocmd-8.10 {fconfigure command} { - list [catch {fconfigure a b} msg] $msg -} {1 {can not find channel named "a"}} + fconfigure $f1 +} -cleanup { + catch {close $f1} +} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -translation lf} +test iocmd-8.10 {fconfigure command} -returnCodes error -body { + fconfigure a b +} -result {can not find channel named "a"} set path(fconfigure.dummy) [makeFile {} fconfigure.dummy] -test iocmd-8.11 {fconfigure command} { - set chan [open $path(fconfigure.dummy) r] - set res [list [catch {fconfigure $chan -froboz blarfo} msg] $msg] - close $chan - set res -} {1 {bad option "-froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}} -test iocmd-8.12 {fconfigure command} { - set chan [open $path(fconfigure.dummy) r] - set res [list [catch {fconfigure $chan -b blarfo} msg] $msg] - close $chan - set res -} {1 {bad option "-b": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}} -test iocmd-8.13 {fconfigure command} { - set chan [open $path(fconfigure.dummy) r] - set res [list [catch {fconfigure $chan -buffer blarfo} msg] $msg] - close $chan - set res -} {1 {bad option "-buffer": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}} +test iocmd-8.11 {fconfigure command} -body { + set chan [open $path(fconfigure.dummy) r] + fconfigure $chan -froboz blarfo +} -returnCodes error -cleanup { + catch {close $chan} +} -result [expectedOpts "-froboz" {}] +test iocmd-8.12 {fconfigure command} -body { + set chan [open $path(fconfigure.dummy) r] + fconfigure $chan -b blarfo +} -returnCodes error -cleanup { + catch {close $chan} +} -result [expectedOpts "-b" {}] +test iocmd-8.13 {fconfigure command} -body { + set chan [open $path(fconfigure.dummy) r] + fconfigure $chan -buffer blarfo +} -returnCodes error -cleanup { + catch {close $chan} +} -result [expectedOpts "-buffer" {}] removeFile fconfigure.dummy test iocmd-8.14 {fconfigure command} { fconfigure stdin -buffers } 4096 test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrPc} -setup { @@ -292,11 +304,11 @@ } -cleanup { close $cli close $srv unset cli srv port rename iocmdSRV {} -} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -connecting, -peername, or -sockname} +} -returnCodes error -result [expectedOpts "-blah" {-connecting -peername -sockname}] test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup { set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0] set port [lindex [fconfigure $srv -sockname] 2] proc iocmdSRV {sock ip port} {close $sock} set cli [socket 127.0.0.1 $port] @@ -335,11 +347,11 @@ fconfigure $tty -blah blih } -cleanup { if {$tty ne ""} { close $tty } -} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -mode} +} -returnCodes error -result [expectedOpts "-blah" {-closemode -inputmode -mode -queue -ttystatus -xchar}] test iocmd-8.19 {fconfigure command / win tty channel} -constraints {nonPortable win} -setup { set tty "" } -body { # might fail early if com1 is unavailable set tty [open com1] @@ -346,11 +358,17 @@ fconfigure $tty -blah blih } -cleanup { if {$tty ne ""} { close $tty } -} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, -handshake, -pollinterval, -sysbuffer, -timeout, -ttycontrol, or -xchar} +} -returnCodes error -result [expectedOpts "-blah" {-closemode -mode -handshake -pollinterval -sysbuffer -timeout -ttycontrol -xchar}] +test iocmd-8.20 {fconfigure command / win console channel} -constraints {nonPortable win} -setup { + # I don't know how else to open the console, but this is non-portable + set console stdin +} -body { + fconfigure $console -blah blih +} -returnCodes error -result [expectedOpts "-blah" {-inputmode}] # TODO: Test parsing of serial channel options (nonPortable, since requires an # open channel to work with). test iocmd-9.1 {eof command} { list [catch {eof} msg] $msg $::errorCode Index: unix/configure ================================================================== --- unix/configure +++ unix/configure @@ -9453,14 +9453,14 @@ $as_echo "$langinfo_ok" >&6; } fi #-------------------------------------------------------------------- -# Check for support of chflags and mkstemps functions +# Check for support of cfmakeraw, chflags and mkstemps functions #-------------------------------------------------------------------- -for ac_func in chflags mkstemps +for ac_func in cfmakeraw chflags mkstemps do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" if eval test \"x\$"$as_ac_var"\" = x"yes"; then : cat >>confdefs.h <<_ACEOF Index: unix/configure.ac ================================================================== --- unix/configure.ac +++ unix/configure.ac @@ -551,14 +551,14 @@ #-------------------------------------------------------------------- SC_ENABLE_LANGINFO #-------------------------------------------------------------------- -# Check for support of chflags and mkstemps functions +# Check for support of cfmakeraw, chflags and mkstemps functions #-------------------------------------------------------------------- -AC_CHECK_FUNCS(chflags mkstemps) +AC_CHECK_FUNCS(cfmakeraw chflags mkstemps) #-------------------------------------------------------------------- # Check for support of isnan() function or macro #-------------------------------------------------------------------- Index: unix/tclUnixChan.c ================================================================== --- unix/tclUnixChan.c +++ unix/tclUnixChan.c @@ -46,10 +46,20 @@ # define PAREXT CMSPAR # endif /* !PAREXT&&CMSPAR */ #endif /* HAVE_TERMIOS_H */ +/* + * The bits supported for describing the closeMode field of TtyState. + */ + +enum CloseModeBits { + CLOSE_DEFAULT, + CLOSE_DRAIN, + CLOSE_DISCARD +}; + /* * Helper macros to make parts of this file clearer. The macros do exactly * what they say on the tin. :-) They also only ever refer to their arguments * once, and so can be used without regard to side effects. */ @@ -56,20 +66,33 @@ #define SET_BITS(var, bits) ((var) |= (bits)) #define CLEAR_BITS(var, bits) ((var) &= ~(bits)) /* - * This structure describes per-instance state of a file based channel. + * These structures describe per-instance state of file-based and serial-based + * channels. */ typedef struct { Tcl_Channel channel; /* Channel associated with this file. */ int fd; /* File handle. */ int validMask; /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which operations are valid on the file. */ } FileState; + +typedef struct { + FileState fileState; +#ifdef SUPPORTS_TTY + int closeMode; /* One of CLOSE_DEFAULT, CLOSE_DRAIN or + * CLOSE_DISCARD. */ + int doReset; /* Whether we should do a terminal reset on + * close. */ + struct termios initState; /* The state of the terminal when it was + * opened. */ +#endif /* SUPPORTS_TTY */ +} TtyState; #ifdef SUPPORTS_TTY /* * The following structure is used to set or get the serial port attributes in @@ -81,11 +104,11 @@ int parity; int data; int stop; } TtyAttrs; -#endif /* !SUPPORTS_TTY */ +#endif /* SUPPORTS_TTY */ #define UNSUPPORTED_OPTION(detail) \ if (interp) { \ Tcl_SetObjResult(interp, Tcl_ObjPrintf( \ "%s not supported for this platform", (detail))); \ @@ -111,10 +134,12 @@ Tcl_WideInt length); static Tcl_WideInt FileWideSeekProc(ClientData instanceData, Tcl_WideInt offset, int mode, int *errorCode); static void FileWatchProc(ClientData instanceData, int mask); #ifdef SUPPORTS_TTY +static int TtyCloseProc(ClientData instanceData, + Tcl_Interp *interp); static void TtyGetAttributes(int fd, TtyAttrs *ttyPtr); static int TtyGetOptionProc(ClientData instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static int TtyGetBaud(speed_t speed); @@ -160,11 +185,11 @@ */ static const Tcl_ChannelType ttyChannelType = { "tty", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - FileCloseProc, /* Close proc. */ + TtyCloseProc, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ NULL, /* Seek proc. */ TtySetOptionProc, /* Set option proc. */ TtyGetOptionProc, /* Get option proc. */ @@ -308,14 +333,15 @@ } /* *---------------------------------------------------------------------- * - * FileCloseProc -- + * FileCloseProc, TtyCloseProc -- * - * This function is called from the generic IO level to perform - * channel-type-specific cleanup when a file based channel is closed. + * These functions are called from the generic IO level to perform + * channel-type-specific cleanup when a file- or tty-based channel is + * closed. * * Results: * 0 if successful, errno if failed. * * Side effects: @@ -345,10 +371,50 @@ } } ckfree(fsPtr); return errorCode; } + +#ifdef SUPPORTS_TTY +static int +TtyCloseProc( + ClientData instanceData, + Tcl_Interp *interp) +{ + TtyState *ttyPtr = instanceData; + + /* + * If we've been asked by the user to drain or flush, do so now. + */ + + switch (ttyPtr->closeMode) { + case CLOSE_DRAIN: + tcdrain(ttyPtr->fileState.fd); + break; + case CLOSE_DISCARD: + tcflush(ttyPtr->fileState.fd, TCIOFLUSH); + break; + default: + /* Do nothing */ + break; + } + + /* + * If we've had our state changed from the default, reset now. + */ + + if (ttyPtr->doReset) { + tcsetattr(ttyPtr->fileState.fd, TCSANOW, &ttyPtr->initState); + } + + /* + * Delegate to close for files. + */ + + return FileCloseProc(instanceData, interp); +} +#endif /* SUPPORTS_TTY */ /* *---------------------------------------------------------------------- * * FileSeekProc -- @@ -576,11 +642,11 @@ ClientData instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ { - FileState *fsPtr = instanceData; + TtyState *fsPtr = instanceData; unsigned int len, vlen; TtyAttrs tty; int argc; const char **argv; struct termios iostate; @@ -599,11 +665,11 @@ /* * system calls results should be checked there. - dl */ - TtySetAttributes(fsPtr->fd, &tty); + TtySetAttributes(fsPtr->fileState.fd, &tty); return TCL_OK; } /* * Option -handshake none|xonxoff|rtscts|dtrdsr @@ -612,11 +678,11 @@ if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) { /* * Reset all handshake options. DTR and RTS are ON by default. */ - tcgetattr(fsPtr->fd, &iostate); + tcgetattr(fsPtr->fileState.fd, &iostate); CLEAR_BITS(iostate.c_iflag, IXON | IXOFF | IXANY); #ifdef CRTSCTS CLEAR_BITS(iostate.c_cflag, CRTSCTS); #endif /* CRTSCTS */ if (Tcl_UtfNcasecmp(value, "NONE", vlen) == 0) { @@ -643,11 +709,11 @@ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", "VALUE", NULL); } return TCL_ERROR; } - tcsetattr(fsPtr->fd, TCSADRAIN, &iostate); + tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate); return TCL_OK; } /* * Option -xchar {\x11 \x13} @@ -666,11 +732,11 @@ } ckfree(argv); return TCL_ERROR; } - tcgetattr(fsPtr->fd, &iostate); + tcgetattr(fsPtr->fileState.fd, &iostate); iostate.c_cc[VSTART] = argv[0][0]; iostate.c_cc[VSTOP] = argv[1][0]; if (argv[0][0] & 0x80 || argv[1][0] & 0x80) { Tcl_UniChar character = 0; @@ -687,11 +753,11 @@ } iostate.c_cc[VSTOP] = character; } ckfree(argv); - tcsetattr(fsPtr->fd, TCSADRAIN, &iostate); + tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate); return TCL_OK; } /* * Option -timeout msec @@ -698,17 +764,17 @@ */ if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) { int msec; - tcgetattr(fsPtr->fd, &iostate); + tcgetattr(fsPtr->fileState.fd, &iostate); if (Tcl_GetInt(interp, value, &msec) != TCL_OK) { return TCL_ERROR; } iostate.c_cc[VMIN] = 0; iostate.c_cc[VTIME] = (msec==0) ? 0 : (msec<100) ? 1 : (msec+50)/100; - tcsetattr(fsPtr->fd, TCSADRAIN, &iostate); + tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate); return TCL_OK; } /* * Option -ttycontrol {DTR 1 RTS 0 BREAK 0} @@ -731,11 +797,11 @@ } ckfree(argv); return TCL_ERROR; } - ioctl(fsPtr->fd, TIOCMGET, &control); + ioctl(fsPtr->fileState.fd, TIOCMGET, &control); for (i = 0; i < argc-1; i += 2) { if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) { ckfree(argv); return TCL_ERROR; } @@ -752,13 +818,13 @@ CLEAR_BITS(control, TIOCM_RTS); } } else if (Tcl_UtfNcasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) { #if defined(TIOCSBRK) && defined(TIOCCBRK) if (flag) { - ioctl(fsPtr->fd, TIOCSBRK, NULL); + ioctl(fsPtr->fileState.fd, TIOCSBRK, NULL); } else { - ioctl(fsPtr->fd, TIOCCBRK, NULL); + ioctl(fsPtr->fileState.fd, TIOCCBRK, NULL); } #else /* TIOCSBRK & TIOCCBRK */ UNSUPPORTED_OPTION("-ttycontrol BREAK"); ckfree(argv); return TCL_ERROR; @@ -774,20 +840,124 @@ ckfree(argv); return TCL_ERROR; } } /* -ttycontrol options loop */ - ioctl(fsPtr->fd, TIOCMSET, &control); + ioctl(fsPtr->fileState.fd, TIOCMSET, &control); ckfree(argv); return TCL_OK; #else /* TIOCMGET&TIOCMSET */ UNSUPPORTED_OPTION("-ttycontrol"); #endif /* TIOCMGET&TIOCMSET */ } + + /* + * Option -closemode drain|discard + */ + + if ((len > 2) && (strncmp(optionName, "-closemode", len) == 0)) { + if (Tcl_UtfNcasecmp(value, "DEFAULT", vlen) == 0) { + fsPtr->closeMode = CLOSE_DEFAULT; + } else if (Tcl_UtfNcasecmp(value, "DRAIN", vlen) == 0) { + fsPtr->closeMode = CLOSE_DRAIN; + } else if (Tcl_UtfNcasecmp(value, "DISCARD", vlen) == 0) { + fsPtr->closeMode = CLOSE_DISCARD; + } else { + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad mode \"%s\" for -closemode: must be" + " default, discard, or drain", value)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", + "VALUE", NULL); + } + return TCL_ERROR; + } + return TCL_OK; + } + + /* + * Option -inputmode normal|password|raw + */ + + if ((len > 2) && (strncmp(optionName, "-inputmode", len) == 0)) { + if (tcgetattr(fsPtr->fileState.fd, &iostate) < 0) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read serial terminal control state: %s", + Tcl_PosixError(interp))); + } + return TCL_ERROR; + } + if (Tcl_UtfNcasecmp(value, "NORMAL", vlen) == 0) { + SET_BITS(iostate.c_iflag, BRKINT | IGNPAR | ISTRIP | ICRNL | IXON); + SET_BITS(iostate.c_oflag, OPOST); + SET_BITS(iostate.c_lflag, ECHO | ECHONL | ICANON | ISIG); + } else if (Tcl_UtfNcasecmp(value, "PASSWORD", vlen) == 0) { + SET_BITS(iostate.c_iflag, BRKINT | IGNPAR | ISTRIP | ICRNL | IXON); + SET_BITS(iostate.c_oflag, OPOST); + CLEAR_BITS(iostate.c_lflag, ECHO); + /* + * Note: password input turns out to be best if you echo the + * newline that the user types. Theoretically we could get users + * to do the processing of this in their scripts, but it always + * feels highly unnatural to do so in practice. + */ + SET_BITS(iostate.c_lflag, ECHONL | ICANON | ISIG); + } else if (Tcl_UtfNcasecmp(value, "RAW", vlen) == 0) { +#ifdef HAVE_CFMAKERAW + cfmakeraw(&iostate); +#else /* !HAVE_CFMAKERAW */ + CLEAR_BITS(iostate.c_iflag, IGNBRK | BRKINT | PARMRK | ISTRIP + | INLCR | IGNCR | ICRNL | IXON); + CLEAR_BITS(iostate.c_oflag, OPOST); + CLEAR_BITS(iostate.c_lflag, ECHO | ECHONL | ICANON | ISIG | IEXTEN); + CLEAR_BITS(iostate.c_cflag, CSIZE | PARENB); + SET_BITS(iostate.c_cflag, CS8); +#endif /* HAVE_CFMAKERAW */ + } else if (Tcl_UtfNcasecmp(value, "RESET", vlen) == 0) { + /* + * Reset to the initial state, whatever that is. + */ + + memcpy(&iostate, &fsPtr->initState, sizeof(struct termios)); + } else { + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad mode \"%s\" for -inputmode: must be" + " normal, password, raw, or reset", value)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", + "VALUE", NULL); + } + return TCL_ERROR; + } + if (tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate) < 0) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't update serial terminal control state: %s", + Tcl_PosixError(interp))); + } + return TCL_ERROR; + } + + /* + * If we've changed the state from default, schedule a reset later. + * Note that this specifically does not detect changes made by calling + * an external stty program; that is deliberate, as it maintains + * compatibility with existing code! + * + * This mechanism in Tcl is not intended to be a full replacement for + * what stty does; it just handles a few common cases and tries not to + * leave things in a broken state. + */ + + fsPtr->doReset = (memcmp(&iostate, &fsPtr->initState, + sizeof(struct termios)) != 0); + return TCL_OK; + } return Tcl_BadChannelOption(interp, optionName, - "mode handshake timeout ttycontrol xchar"); + "closemode inputmode mode handshake timeout ttycontrol xchar"); } /* *---------------------------------------------------------------------- * @@ -811,28 +981,86 @@ ClientData instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ { - FileState *fsPtr = instanceData; + TtyState *fsPtr = instanceData; unsigned int len; char buf[3*TCL_INTEGER_SPACE + 16]; int valid = 0; /* Flag if valid option parsed. */ + struct termios iostate; if (optionName == NULL) { len = 0; } else { len = strlen(optionName); } + + /* + * Get option -closemode + */ + + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-closemode"); + } + if (len==0 || (len>1 && strncmp(optionName, "-closemode", len)==0)) { + switch (fsPtr->closeMode) { + case CLOSE_DRAIN: + Tcl_DStringAppendElement(dsPtr, "drain"); + break; + case CLOSE_DISCARD: + Tcl_DStringAppendElement(dsPtr, "discard"); + break; + default: + Tcl_DStringAppendElement(dsPtr, "default"); + break; + } + } + + /* + * Get option -inputmode + * + * This is a great simplification of the underlying reality, but actually + * represents what almost all scripts really want to know. + */ + + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-inputmode"); + } + if (len==0 || (len>1 && strncmp(optionName, "-inputmode", len)==0)) { + valid = 1; + if (tcgetattr(fsPtr->fileState.fd, &iostate) < 0) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read serial terminal control state: %s", + Tcl_PosixError(interp))); + } + return TCL_ERROR; + } + if (iostate.c_lflag & ICANON) { + if (iostate.c_lflag & ECHO) { + Tcl_DStringAppendElement(dsPtr, "normal"); + } else { + Tcl_DStringAppendElement(dsPtr, "password"); + } + } else { + Tcl_DStringAppendElement(dsPtr, "raw"); + } + } + + /* + * Get option -mode + */ + if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-mode"); } if (len==0 || (len>2 && strncmp(optionName, "-mode", len)==0)) { TtyAttrs tty; valid = 1; - TtyGetAttributes(fsPtr->fd, &tty); + TtyGetAttributes(fsPtr->fileState.fd, &tty); sprintf(buf, "%d,%c,%d,%d", tty.baud, tty.parity, tty.data, tty.stop); Tcl_DStringAppendElement(dsPtr, buf); } /* @@ -842,15 +1070,14 @@ if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-xchar"); Tcl_DStringStartSublist(dsPtr); } if (len==0 || (len>1 && strncmp(optionName, "-xchar", len)==0)) { - struct termios iostate; Tcl_DString ds; valid = 1; - tcgetattr(fsPtr->fd, &iostate); + tcgetattr(fsPtr->fileState.fd, &iostate); Tcl_DStringInit(&ds); Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds); Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds)); TclDStringClear(&ds); @@ -871,14 +1098,14 @@ if ((len > 1) && (strncmp(optionName, "-queue", len) == 0)) { int inQueue=0, outQueue=0, inBuffered, outBuffered; valid = 1; - GETREADQUEUE(fsPtr->fd, inQueue); - GETWRITEQUEUE(fsPtr->fd, outQueue); - inBuffered = Tcl_InputBuffered(fsPtr->channel); - outBuffered = Tcl_OutputBuffered(fsPtr->channel); + GETREADQUEUE(fsPtr->fileState.fd, inQueue); + GETWRITEQUEUE(fsPtr->fileState.fd, outQueue); + inBuffered = Tcl_InputBuffered(fsPtr->fileState.channel); + outBuffered = Tcl_OutputBuffered(fsPtr->fileState.channel); sprintf(buf, "%d", inBuffered+inQueue); Tcl_DStringAppendElement(dsPtr, buf); sprintf(buf, "%d", outBuffered+outQueue); Tcl_DStringAppendElement(dsPtr, buf); @@ -893,20 +1120,46 @@ if ((len > 4) && (strncmp(optionName, "-ttystatus", len) == 0)) { int status; valid = 1; - ioctl(fsPtr->fd, TIOCMGET, &status); + ioctl(fsPtr->fileState.fd, TIOCMGET, &status); TtyModemStatusStr(status, dsPtr); } #endif /* TIOCMGET */ + +#if defined(TIOCGWINSZ) + /* + * Get option -winsize + * Option is readonly and returned by [fconfigure chan -winsize] but not + * returned by [fconfigure chan] without explicit option name. + */ + + if ((len > 1) && (strncmp(optionName, "-winsize", len) == 0)) { + struct winsize ws; + + valid = 1; + if (ioctl(fsPtr->fileState.fd, TIOCGWINSZ, &ws) < 0) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read terminal size: %s", + Tcl_PosixError(interp))); + } + return TCL_ERROR; + } + sprintf(buf, "%d", ws.ws_col); + Tcl_DStringAppendElement(dsPtr, buf); + sprintf(buf, "%d", ws.ws_row); + Tcl_DStringAppendElement(dsPtr, buf); + } +#endif /* TIOCGWINSZ */ if (valid) { return TCL_OK; } return Tcl_BadChannelOption(interp, optionName, - "mode queue ttystatus xchar"); + "closemode inputmode mode queue ttystatus winsize xchar"); } static const struct {int baud; speed_t speed;} speeds[] = { #ifdef B0 {0, B0}, @@ -1373,11 +1626,11 @@ int mode, /* POSIX open mode. */ int permissions) /* If the open involves creating a file, with * what modes to create it? */ { int fd, channelPermissions; - FileState *fsPtr; + TtyState *fsPtr; const char *native, *translation; char channelName[16 + TCL_INTEGER_SPACE]; const Tcl_ChannelType *channelTypePtr; switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) { @@ -1429,12 +1682,10 @@ * inherit this fd. */ fcntl(fd, F_SETFD, FD_CLOEXEC); - sprintf(channelName, "file%d", fd); - #ifdef SUPPORTS_TTY if (strcmp(native, "/dev/tty") != 0 && isatty(fd)) { /* * Initialize the serial port to a set of sane parameters. Especially * important if the remote device is set to echo and the serial port @@ -1450,22 +1701,31 @@ */ translation = "auto crlf"; channelTypePtr = &ttyChannelType; TtyInit(fd); + sprintf(channelName, "serial%d", fd); } else #endif /* SUPPORTS_TTY */ { translation = NULL; channelTypePtr = &fileChannelType; + sprintf(channelName, "file%d", fd); + } + + fsPtr = ckalloc(sizeof(TtyState)); + fsPtr->fileState.validMask = channelPermissions | TCL_EXCEPTION; + fsPtr->fileState.fd = fd; +#ifdef SUPPORTS_TTY + if (channelTypePtr == &ttyChannelType) { + fsPtr->closeMode = CLOSE_DEFAULT; + fsPtr->doReset = 0; + tcgetattr(fsPtr->fileState.fd, &fsPtr->initState); } +#endif /* SUPPORTS_TTY */ - fsPtr = ckalloc(sizeof(FileState)); - fsPtr->validMask = channelPermissions | TCL_EXCEPTION; - fsPtr->fd = fd; - - fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName, + fsPtr->fileState.channel = Tcl_CreateChannel(channelTypePtr, channelName, fsPtr, channelPermissions); if (translation != NULL) { /* * Gotcha. Most modems need a "\r" at the end of the command sequence. @@ -1473,18 +1733,18 @@ * because it never got a "\r" to actually invoke the command. So, by * default, newlines are translated to "\r\n" on output to avoid "bug" * reports that the serial port isn't working. */ - if (Tcl_SetChannelOption(interp, fsPtr->channel, "-translation", - translation) != TCL_OK) { - Tcl_Close(NULL, fsPtr->channel); + if (Tcl_SetChannelOption(interp, fsPtr->fileState.channel, + "-translation", translation) != TCL_OK) { + Tcl_Close(NULL, fsPtr->fileState.channel); return NULL; } } - return fsPtr->channel; + return fsPtr->fileState.channel; } /* *---------------------------------------------------------------------- * @@ -1505,11 +1765,11 @@ Tcl_MakeFileChannel( ClientData handle, /* OS level handle. */ int mode) /* ORed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { - FileState *fsPtr; + TtyState *fsPtr; char channelName[16 + TCL_INTEGER_SPACE]; int fd = PTR2INT(handle); const Tcl_ChannelType *channelTypePtr; struct sockaddr sockaddr; socklen_t sockaddrLen = sizeof(sockaddr); @@ -1524,26 +1784,34 @@ if (isatty(fd)) { channelTypePtr = &ttyChannelType; sprintf(channelName, "serial%d", fd); } else #endif /* SUPPORTS_TTY */ - if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0) - && (sockaddrLen > 0) - && (sockaddr.sa_family == AF_INET || sockaddr.sa_family == AF_INET6)) { + if ((getsockname(fd, (struct sockaddr *) &sockaddr, &sockaddrLen) == 0) + && (sockaddrLen > 0) + && (sockaddr.sa_family == AF_INET + || sockaddr.sa_family == AF_INET6)) { return TclpMakeTcpClientChannelMode(INT2PTR(fd), mode); } else { channelTypePtr = &fileChannelType; sprintf(channelName, "file%d", fd); } - fsPtr = ckalloc(sizeof(FileState)); - fsPtr->fd = fd; - fsPtr->validMask = mode | TCL_EXCEPTION; - fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName, + fsPtr = ckalloc(sizeof(TtyState)); + fsPtr->fileState.fd = fd; + fsPtr->fileState.validMask = mode | TCL_EXCEPTION; + fsPtr->fileState.channel = Tcl_CreateChannel(channelTypePtr, channelName, fsPtr, mode); +#ifdef SUPPORTS_TTY + if (channelTypePtr == &ttyChannelType) { + fsPtr->closeMode = CLOSE_DEFAULT; + fsPtr->doReset = 0; + tcgetattr(fsPtr->fileState.fd, &fsPtr->initState); + } +#endif /* SUPPORTS_TTY */ - return fsPtr->channel; + return fsPtr->fileState.channel; } /* *---------------------------------------------------------------------- * Index: win/tclWinConsole.c ================================================================== --- win/tclWinConsole.c +++ win/tclWinConsole.c @@ -29,12 +29,14 @@ /* * Bit masks used in the flags field of the ConsoleInfo structure below. */ -#define CONSOLE_PENDING (1<<0) /* Message is pending in the queue. */ -#define CONSOLE_ASYNC (1<<1) /* Channel is non-blocking. */ +#define CONSOLE_PENDING (1<<0) /* Message is pending in the queue. */ +#define CONSOLE_ASYNC (1<<1) /* Channel is non-blocking. */ +#define CONSOLE_READ_OPS (1<<4) /* Channel supports read-related ops. */ +#define CONSOLE_RESET (1<<5) /* Console mode needs to be reset. */ /* * Bit masks used in the sharedFlags field of the ConsoleInfo structure below. */ @@ -100,10 +102,11 @@ int readFlags; /* Flags that are shared with the reader * thread. Access is synchronized with the * readable object. */ int bytesRead; /* Number of bytes in the buffer. */ int offset; /* Number of bytes read out of the buffer. */ + DWORD initMode; /* Initial console mode. */ char buffer[CONSOLE_BUFFER_SIZE]; /* Data consumed by reader thread. */ } ConsoleInfo; typedef struct { @@ -142,16 +145,22 @@ Tcl_Interp *interp); static int ConsoleEventProc(Tcl_Event *evPtr, int flags); static void ConsoleExitHandler(ClientData clientData); static int ConsoleGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr); +static int ConsoleGetOptionProc(ClientData instanceData, + Tcl_Interp *interp, const char *optionName, + Tcl_DString *dsPtr); static void ConsoleInit(void); static int ConsoleInputProc(ClientData instanceData, char *buf, int toRead, int *errorCode); static int ConsoleOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCode); static DWORD WINAPI ConsoleReaderThread(LPVOID arg); +static int ConsoleSetOptionProc(ClientData instanceData, + Tcl_Interp *interp, const char *optionName, + const char *value); static void ConsoleSetupProc(ClientData clientData, int flags); static void ConsoleWatchProc(ClientData instanceData, int mask); static DWORD WINAPI ConsoleWriterThread(LPVOID arg); static void ProcExitHandler(ClientData clientData); static int WaitForRead(ConsoleInfo *infoPtr, int blocking); @@ -173,12 +182,12 @@ TCL_CHANNEL_VERSION_5, /* v5 channel */ ConsoleCloseProc, /* Close proc. */ ConsoleInputProc, /* Input proc. */ ConsoleOutputProc, /* Output proc. */ NULL, /* Seek proc. */ - NULL, /* Set option proc. */ - NULL, /* Get option proc. */ + ConsoleSetOptionProc, /* Set option proc. */ + ConsoleGetOptionProc, /* Get option proc. */ ConsoleWatchProc, /* Set up notifier to watch the channel. */ ConsoleGetHandleProc, /* Get an OS handle from channel. */ NULL, /* close2proc. */ ConsoleBlockModeProc, /* Set blocking or non-blocking mode. */ NULL, /* Flush proc. */ @@ -565,10 +574,21 @@ CloseHandle(consolePtr->writer.thread); CloseHandle(consolePtr->writer.readyEvent); consolePtr->writer.thread = NULL; } consolePtr->validMask &= ~TCL_WRITABLE; + + /* + * If the user has been tinkering with the mode, reset it now. We ignore + * any errors from this; we're quite possibly about to close or exit + * anyway. + */ + + if ((consolePtr->flags & CONSOLE_READ_OPS) && + (consolePtr->flags & CONSOLE_RESET)) { + SetConsoleMode(consolePtr->handle, consolePtr->initMode); + } /* * Don't close the Win32 handle if the handle is a standard channel during * the thread exit process. Otherwise, one thread may kill the stdio of * another. @@ -588,11 +608,11 @@ /* * Remove the file from the list of watched files. */ - for (nextPtrPtr = &(tsdPtr->firstConsolePtr), infoPtr = *nextPtrPtr; + for (nextPtrPtr = &tsdPtr->firstConsolePtr, infoPtr = *nextPtrPtr; infoPtr != NULL; nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) { if (infoPtr == (ConsoleInfo *) consolePtr) { *nextPtrPtr = infoPtr->nextPtr; break; @@ -1330,11 +1350,13 @@ * Make sure the console input buffer is ready for only character * input notifications and the buffer is set for line buffering. IOW, * we only want to catch when complete lines are ready for reading. */ - GetConsoleMode(infoPtr->handle, &modes); + infoPtr->flags |= CONSOLE_READ_OPS; + GetConsoleMode(infoPtr->handle, &infoPtr->initMode); + modes = infoPtr->initMode; modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT); modes |= ENABLE_LINE_INPUT; SetConsoleMode(infoPtr->handle, modes); infoPtr->reader.readyEvent = CreateEvent(NULL, TRUE, TRUE, NULL); @@ -1411,13 +1433,220 @@ } else { infoPtr->threadId = NULL; } Tcl_MutexUnlock(&consoleMutex); } + +/* + *---------------------------------------------------------------------- + * + * ConsoleSetOptionProc -- + * + * Sets an option on a channel. + * + * Results: + * A standard Tcl result. Also sets the interp's result on error if + * interp is not NULL. + * + * Side effects: + * May modify an option on a console. Sets Error message if needed (by + * calling Tcl_BadChannelOption). + * + *---------------------------------------------------------------------- + */ + +static int +ConsoleSetOptionProc( + ClientData instanceData, /* File state. */ + Tcl_Interp *interp, /* For error reporting - can be NULL. */ + const char *optionName, /* Which option to set? */ + const char *value) /* New value for option. */ +{ + ConsoleInfo *infoPtr = instanceData; + int len = strlen(optionName); + int vlen = strlen(value); + + /* + * Option -inputmode normal|password|raw + */ + + if ((infoPtr->flags & CONSOLE_READ_OPS) && (len > 1) && + (strncmp(optionName, "-inputmode", len) == 0)) { + DWORD mode; + + if (GetConsoleMode(infoPtr->handle, &mode) == 0) { + TclWinConvertError(GetLastError()); + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read console mode: %s", + Tcl_PosixError(interp))); + } + return TCL_ERROR; + } + if (Tcl_UtfNcasecmp(value, "NORMAL", vlen) == 0) { + mode |= ENABLE_ECHO_INPUT | ENABLE_LINE_INPUT; + } else if (Tcl_UtfNcasecmp(value, "PASSWORD", vlen) == 0) { + mode |= ENABLE_LINE_INPUT; + mode &= ~ENABLE_ECHO_INPUT; + } else if (Tcl_UtfNcasecmp(value, "RAW", vlen) == 0) { + mode &= ~(ENABLE_ECHO_INPUT | ENABLE_LINE_INPUT); + } else if (Tcl_UtfNcasecmp(value, "RESET", vlen) == 0) { + /* + * Reset to the initial mode, whatever that is. + */ + + mode = infoPtr->initMode; + } else { + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad mode \"%s\" for -inputmode: must be" + " normal, password, raw, or reset", value)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", + "VALUE", NULL); + } + return TCL_ERROR; + } + if (SetConsoleMode(infoPtr->handle, mode) == 0) { + TclWinConvertError(GetLastError()); + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't set console mode: %s", + Tcl_PosixError(interp))); + } + return TCL_ERROR; + } + + /* + * If we've changed the mode from default, schedule a reset later. + */ + + if (mode == infoPtr->initMode) { + infoPtr->flags &= ~CONSOLE_RESET; + } else { + infoPtr->flags |= CONSOLE_RESET; + } + return TCL_OK; + } + + if (infoPtr->flags & CONSOLE_READ_OPS) { + return Tcl_BadChannelOption(interp, optionName, "inputmode"); + } else { + return Tcl_BadChannelOption(interp, optionName, ""); + } +} + +/* + *---------------------------------------------------------------------- + * + * ConsoleGetOptionProc -- + * + * Gets a mode associated with an IO channel. If the optionName arg is + * non-NULL, retrieves the value of that option. If the optionName arg is + * NULL, retrieves a list of alternating option names and values for the + * given channel. + * + * Results: + * A standard Tcl result. Also sets the supplied DString to the string + * value of the option(s) returned. Sets error message if needed + * (by calling Tcl_BadChannelOption). + * + *---------------------------------------------------------------------- + */ + +static int +ConsoleGetOptionProc( + ClientData instanceData, /* File state. */ + Tcl_Interp *interp, /* For error reporting - can be NULL. */ + const char *optionName, /* Option to get. */ + Tcl_DString *dsPtr) /* Where to store value(s). */ +{ + ConsoleInfo *infoPtr = instanceData; + int valid = 0; /* Flag if valid option parsed. */ + unsigned int len; + char buf[TCL_INTEGER_SPACE]; + + if (optionName == NULL) { + len = 0; + } else { + len = strlen(optionName); + } + + /* + * Get option -inputmode + * + * This is a great simplification of the underlying reality, but actually + * represents what almost all scripts really want to know. + */ + + if (infoPtr->flags & CONSOLE_READ_OPS) { + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-inputmode"); + } + if (len==0 || (len>1 && strncmp(optionName, "-inputmode", len)==0)) { + DWORD mode; + + valid = 1; + if (GetConsoleMode(infoPtr->handle, &mode) == 0) { + TclWinConvertError(GetLastError()); + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read console mode: %s", + Tcl_PosixError(interp))); + } + return TCL_ERROR; + } + if (mode & ENABLE_LINE_INPUT) { + if (mode & ENABLE_ECHO_INPUT) { + Tcl_DStringAppendElement(dsPtr, "normal"); + } else { + Tcl_DStringAppendElement(dsPtr, "password"); + } + } else { + Tcl_DStringAppendElement(dsPtr, "raw"); + } + } + } + + /* + * Get option -winsize + * Option is readonly and returned by [fconfigure chan -winsize] but not + * returned by [fconfigure chan] without explicit option name. + */ + + if ((len > 1) && (strncmp(optionName, "-winsize", len) == 0)) { + CONSOLE_SCREEN_BUFFER_INFO consoleInfo; + + valid = 1; + if (!GetConsoleScreenBufferInfo(infoPtr->handle, &consoleInfo)) { + TclWinConvertError(GetLastError()); + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read console size: %s", + Tcl_PosixError(interp))); + } + return TCL_ERROR; + } + sprintf(buf, "%d", + consoleInfo.srWindow.Right - consoleInfo.srWindow.Left + 1); + Tcl_DStringAppendElement(dsPtr, buf); + sprintf(buf, "%d", + consoleInfo.srWindow.Bottom - consoleInfo.srWindow.Top + 1); + Tcl_DStringAppendElement(dsPtr, buf); + } + + if (valid) { + return TCL_OK; + } + if (infoPtr->flags & CONSOLE_READ_OPS) { + return Tcl_BadChannelOption(interp, optionName, "inputmode winsize"); + } else { + return Tcl_BadChannelOption(interp, optionName, ""); + } +} /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ Index: win/tclWinSerial.c ================================================================== --- win/tclWinSerial.c +++ win/tclWinSerial.c @@ -41,10 +41,19 @@ */ #define SERIAL_EOF (1<<2) /* Serial has reached EOF. */ #define SERIAL_ERROR (1<<4) +/* + * Bit masks used for noting whether to drain or discard output on close. They + * are disjoint from each other; at most one may be set at a time. + */ + +#define SERIAL_CLOSE_DRAIN (1<<6) /* Drain all output on close. */ +#define SERIAL_CLOSE_DISCARD (1<<7) /* Discard all output on close. */ +#define SERIAL_CLOSE_MASK (3<<6) /* Both two bits above. */ + /* * Default time to block between checking status on the serial port. */ #define SERIAL_DEFAULT_BLOCKTIME 10 /* 10 msec */ @@ -602,11 +611,10 @@ CloseHandle(serialPtr->osRead.hEvent); } serialPtr->validMask &= ~TCL_READABLE; if (serialPtr->writeThread) { - TclPipeThreadStop(&serialPtr->writeTI, serialPtr->writeThread); CloseHandle(serialPtr->osWrite.hEvent); CloseHandle(serialPtr->evWritable); CloseHandle(serialPtr->writeThread); @@ -1276,11 +1284,11 @@ */ if (!TclPipeThreadWaitForSignal(&pipeTI)) { /* exit */ break; } - infoPtr = (SerialInfo *)pipeTI->clientData; + infoPtr = (SerialInfo *) pipeTI->clientData; buf = infoPtr->writeBuf; toWrite = infoPtr->toWrite; myWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); @@ -1340,11 +1348,29 @@ Tcl_ThreadAlert(infoPtr->threadId); } Tcl_MutexUnlock(&serialMutex); } - /* Worker exit, so inform the main thread or free TI-structure (if owned) */ + /* + * We're about to close, so do any drain or discard required. + */ + + if (infoPtr) { + switch (infoPtr->flags & SERIAL_CLOSE_MASK) { + case SERIAL_CLOSE_DRAIN: + FlushFileBuffers(infoPtr->handle); + break; + case SERIAL_CLOSE_DISCARD: + PurgeComm(infoPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR); + break; + } + } + + /* + * Worker exit, so inform the main thread or free TI-structure (if owned). + */ + TclPipeThreadExit(&pipeTI); return 0; } @@ -1606,10 +1632,36 @@ * as that would let us use Tcl_GetIndexFromObj()... */ len = strlen(optionName); vlen = strlen(value); + + /* + * Option -closemode drain|discard|default + */ + + if ((len > 2) && (strncmp(optionName, "-closemode", len) == 0)) { + if (Tcl_UtfNcasecmp(value, "DEFAULT", vlen) == 0) { + infoPtr->flags &= ~SERIAL_CLOSE_MASK; + } else if (Tcl_UtfNcasecmp(value, "DRAIN", vlen) == 0) { + infoPtr->flags &= ~SERIAL_CLOSE_MASK; + infoPtr->flags |= SERIAL_CLOSE_DRAIN; + } else if (Tcl_UtfNcasecmp(value, "DISCARD", vlen) == 0) { + infoPtr->flags &= ~SERIAL_CLOSE_MASK; + infoPtr->flags |= SERIAL_CLOSE_DISCARD; + } else { + if (interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad mode \"%s\" for -closemode: must be" + " default, discard, or drain", value)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", + "VALUE", NULL); + } + return TCL_ERROR; + } + return TCL_OK; + } /* * Option -mode baud,parity,databits,stopbits */ @@ -1936,11 +1988,12 @@ return TCL_OK; } return Tcl_BadChannelOption(interp, optionName, - "mode handshake pollinterval sysbuffer timeout ttycontrol xchar"); + "closemode mode handshake pollinterval sysbuffer timeout " + "ttycontrol xchar"); getStateFailed: if (interp != NULL) { TclWinConvertError(GetLastError()); Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1995,10 +2048,31 @@ if (optionName == NULL) { len = 0; } else { len = strlen(optionName); } + + /* + * Get option -closemode + */ + + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-closemode"); + } + if (len==0 || (len>1 && strncmp(optionName, "-closemode", len)==0)) { + switch (infoPtr->flags & SERIAL_CLOSE_MASK) { + case SERIAL_CLOSE_DRAIN: + Tcl_DStringAppendElement(dsPtr, "drain"); + break; + case SERIAL_CLOSE_DISCARD: + Tcl_DStringAppendElement(dsPtr, "discard"); + break; + default: + Tcl_DStringAppendElement(dsPtr, "default"); + break; + } + } /* * Get option -mode */ @@ -2172,11 +2246,12 @@ if (valid) { return TCL_OK; } return Tcl_BadChannelOption(interp, optionName, - "mode pollinterval lasterror queue sysbuffer ttystatus xchar"); + "closemode mode pollinterval lasterror queue sysbuffer ttystatus " + "xchar"); } /* *---------------------------------------------------------------------- *