summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2019-03-27 13:54:18 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2019-03-27 13:54:18 (GMT)
commitbc322bfae7b2bcfc1c9946a184ddf7a7c7e5d4e1 (patch)
treeedd3ae5ba2a512617e59cb7e7b16928e396d3d5e /win
parent7ff500ca4d515a5bbf1b6b4442d857c369c727fd (diff)
downloadtcl-bc322bfae7b2bcfc1c9946a184ddf7a7c7e5d4e1.zip
tcl-bc322bfae7b2bcfc1c9946a184ddf7a7c7e5d4e1.tar.gz
tcl-bc322bfae7b2bcfc1c9946a184ddf7a7c7e5d4e1.tar.bz2
Partial implementation on Windows. UNTESTED
Diffstat (limited to 'win')
-rw-r--r--win/tclWinConsole.c212
1 files changed, 206 insertions, 6 deletions
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index f8b67a3..acb00cb 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -31,8 +31,10 @@ TCL_DECLARE_MUTEX(consoleMutex)
* 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.
@@ -102,6 +104,7 @@ typedef struct ConsoleInfo {
* 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;
@@ -144,12 +147,18 @@ 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);
@@ -175,8 +184,8 @@ static const Tcl_ChannelType consoleChannelType = {
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. */
@@ -569,6 +578,17 @@ ConsoleCloseProc(
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.
@@ -590,7 +610,7 @@ ConsoleCloseProc(
* 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) {
@@ -1332,7 +1352,9 @@ TclWinOpenConsoleChannel(
* 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);
@@ -1415,6 +1437,184 @@ ConsoleThreadActionProc(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+
+ /*
+ * 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, "inputmode");
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+
+ 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");
+ }
+ }
+ }
+
+ if (valid) {
+ return TCL_OK;
+ }
+ if (infoPtr->flags & CONSOLE_READ_OPS) {
+ return Tcl_BadChannelOption(interp, optionName, "inputmode");
+ } else {
+ return Tcl_BadChannelOption(interp, optionName, "");
+ }
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4