diff options
| -rw-r--r-- | ChangeLog | 12 | ||||
| -rw-r--r-- | doc/wish.1 | 27 | ||||
| -rw-r--r-- | generic/tkMain.c | 66 | ||||
| -rw-r--r-- | tests/main.test | 90 |
4 files changed, 153 insertions, 42 deletions
@@ -1,3 +1,15 @@ +2003-09-05 Don Porter <dgp@users.sourceforge.net> + + * doc/wish.1: Implementation of TIPs 137/151. + * generic/tkMain.c (Tk_MainEx): Added recognition of the -encoding + * tests/main.test: command line option by Tk_MainEx() + and thus by wish, and any other program built on Tk_MainEx(). + [Patch 800139]. + This is a ***POTENTIAL INCOMPATIBILITY*** only for those C programs + that embed Tcl and Tk, build on Tk_MainEx(), and make use of + Tk_MainEx's former ability to pass a leading "-encoding" option to + interactive shell operations. + 2003-08-27 Donal K. Fellows <fellowsd@cs.man.ac.uk> * generic/tkListbox.c (ListboxSelect): Remove unused variable @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: wish.1,v 1.3 2003/02/13 22:09:12 kennykb Exp $ +'\" RCS: @(#) $Id: wish.1,v 1.4 2003/09/05 22:44:39 dgp Exp $ '\" .so man.macros .TH wish 1 8.0 Tk "Tk Applications" @@ -14,8 +14,13 @@ .SH NAME wish \- Simple windowing shell .SH SYNOPSIS -\fBwish\fR ?\fIfileName arg arg ...\fR? +\fBwish\fR ?-encoding \fIname\fR? ?\fIfileName arg arg ...\fR? .SH OPTIONS +.IP "\fB\-encoding \fIname\fR" 20 +.VS 8.5 +Specifies the encoding of the text stored in \fIfileName\fR. +This option is only recognized prior to the \fIfileName\fR argument. +.VE 8.5 .IP "\fB\-colormap \fInew\fR" 20 Specifies that the window should have a new private colormap instead of using the default colormap for the screen. @@ -32,14 +37,12 @@ as the name of the interpreter for \fBsend\fR commands. Execute all X server commands synchronously, so that errors are reported immediately. This will result in much slower execution, but it is useful for debugging. -.VS 8.0 br .IP "\fB\-use\fR \fIid\fR" 20 Specifies that the main window for the application is to be embedded in the window whose identifier is \fIid\fR, instead of being created as an independent toplevel window. \fIId\fR must be specified in the same way as the value for the \fB\-use\fR option for toplevel widgets (i.e. it has a form like that returned by the \fBwinfo id\fR command). -.VE .IP "\fB\-visual \fIvisual\fR" 20 Specifies the visual to use for the window. \fIVisual\fR may have any of the forms supported by the \fBTk_GetVisual\fR @@ -57,16 +60,22 @@ to a script instead of having \fBwish\fR interpret them. language, the Tk toolkit, and a main program that reads commands from standard input or from a file. It creates a main window and then processes Tcl commands. -If \fBwish\fR is invoked with no arguments, or with a first argument -that starts with ``\-'', then it reads Tcl commands interactively from -standard input. +If \fBwish\fR is invoked with arguments, then the first few +arguments, ?\fB-encoding \fIname\fR? ?\fIfileName\fR? specify the +name of a script file, and, optionally, the +encoding of the text data stored in that script file. A value +for \fIfileName\fR is recognized if the appropriate argument +does not start with ``\-''. +.PP +If there are no arguments, or the arguments do not specify a \fIfileName\fR, +then wish reads Tcl commands interactively from standard input. It will continue processing commands until all windows have been deleted or until end-of-file is reached on standard input. If there exists a file \fB.wishrc\fR in the home directory of the user, \fBwish\fR evaluates the file as a Tcl script just before reading the first command from standard input. .PP -If \fBwish\fR is invoked with an initial \fIfileName\fR argument, then +If arguments to \fBwish\fR do specify a \fIfileName\fR, then \fIfileName\fR is treated as the name of a script file. \fBWish\fR will evaluate the script in \fIfileName\fR (which presumably creates a user interface), then it will respond to events @@ -170,7 +179,6 @@ When \fBwish\fR starts up, it treats all three lines as comments, since the backslash at the end of the second line causes the third line to be treated as part of the comment on the second line. .PP -.VS 8.4 The end of a script file may be marked either by the physical end of the medium, or by the character, '\\032' ('\\u001a', control-Z). If this character is present in the file, the \fBwish\fR application @@ -178,7 +186,6 @@ will read text up to but not including the character. An application that requires this character in the file may encode it as ``\\032'', ``\\x1a'', or ``\\u001a''; or may generate it by use of commands such as \fBformat\fR or \fBbinary\fR. -.VE .SH PROMPTS .PP When \fBwish\fR is invoked interactively it normally prompts for each diff --git a/generic/tkMain.c b/generic/tkMain.c index d3e3a13..2cb9ec1 100644 --- a/generic/tkMain.c +++ b/generic/tkMain.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMain.c,v 1.15 2002/12/13 16:54:35 dgp Exp $ + * RCS: @(#) $Id: tkMain.c,v 1.16 2003/09/05 22:44:39 dgp Exp $ */ #include <ctype.h> @@ -99,10 +99,11 @@ Tk_MainEx(argc, argv, appInitProc, interp) * to execute commands. */ Tcl_Interp *interp; { + Tcl_Obj *path; + CONST char *encodingName; char *args; char buf[TCL_INTEGER_SPACE]; int code; - size_t length; Tcl_Channel inChannel, outChannel; Tcl_DString argString; ThreadSpecificData *tsdPtr; @@ -134,24 +135,37 @@ Tk_MainEx(argc, argv, appInitProc, interp) #endif /* - * Parse command-line arguments. A leading "-file" argument is - * ignored (a historical relic from the distant past). If the - * next argument doesn't start with a "-" then strip it off and - * use it as the name of a script file to process. + * If the application has not already set a startup script, parse + * the first few command line arguments to determine the script + * path and encoding. */ - if (argc > 1) { - length = strlen(argv[1]); - if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) { - argc--; - argv++; - } - } - if (TclGetStartupScriptFileName() == NULL) { - if ((argc > 1) && (argv[1][0] != '-')) { - TclSetStartupScriptFileName(argv[1]); + if (NULL == Tcl_GetStartupScript(NULL)) { + size_t length; + + /* Check whether first 3 args (argv[1] - argv[3]) look like + * -encoding ENCODING FILENAME + * or like + * FILENAME + * or like + * -file FILENAME (ancient history support only) + */ + + if ((argc > 3) && (0 == strcmp("-encoding", argv[1])) + && ('-' != argv[3][0])) { + Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]); + argc -= 3; + argv += 3; + } else if ((argc > 1) && ('-' != argv[1][0])) { + Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL); argc--; argv++; + } else if ((argc > 2) && (length = strlen(argv[1])) + && (length > 1) && (0 == strncmp("-file", argv[1], length)) + && ('-' != argv[2][0])) { + Tcl_SetStartupScript(Tcl_NewStringObj(argv[2], -1), NULL); + argc -= 2; + argv += 2; } } @@ -167,11 +181,15 @@ Tk_MainEx(argc, argv, appInitProc, interp) ckfree(args); sprintf(buf, "%d", argc-1); - if (TclGetStartupScriptFileName() == NULL) { + path = Tcl_GetStartupScript(&encodingName); + if (NULL == path) { Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString); } else { - TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL, - TclGetStartupScriptFileName(), -1, &argString)); + int numBytes; + CONST char *pathName = Tcl_GetStringFromObj(path, &numBytes); + Tcl_ExternalToUtfDString(NULL, pathName, numBytes, &argString); + path = Tcl_NewStringObj(Tcl_DStringValue(&argString), -1); + Tcl_SetStartupScript(path, encodingName); } Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY); @@ -212,8 +230,7 @@ Tk_MainEx(argc, argv, appInitProc, interp) tsdPtr->tty = isatty(0); #endif Tcl_SetVar(interp, "tcl_interactive", - ((TclGetStartupScriptFileName() == NULL) - && tsdPtr->tty) ? "1" : "0", TCL_GLOBAL_ONLY); + ((path == NULL) && tsdPtr->tty) ? "1" : "0", TCL_GLOBAL_ONLY); /* * Invoke application-specific initialization. @@ -226,11 +243,13 @@ Tk_MainEx(argc, argv, appInitProc, interp) /* * Invoke the script specified on the command line, if any. + * Must fetch it again, as the appInitProc might have reset it. */ - if (TclGetStartupScriptFileName() != NULL) { + path = Tcl_GetStartupScript(&encodingName); + if (path != NULL) { Tcl_ResetResult(interp); - code = Tcl_EvalFile(interp, TclGetStartupScriptFileName()); + code = Tcl_FSEvalFileEx(interp, path, encodingName); if (code != TCL_OK) { /* * The following statement guarantees that the errorInfo @@ -282,6 +301,7 @@ Tk_MainEx(argc, argv, appInitProc, interp) Tk_MainLoop(); Tcl_DeleteInterp(interp); + Tcl_SetStartupScript(NULL, NULL); Tcl_Exit(0); } diff --git a/tests/main.test b/tests/main.test index 17fbaf9..ff86dc2 100644 --- a/tests/main.test +++ b/tests/main.test @@ -8,24 +8,96 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: main.test,v 1.7 2003/04/01 21:06:41 dgp Exp $ +# RCS: @(#) $Id: main.test,v 1.8 2003/09/05 22:44:39 dgp Exp $ package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands -test main-1.1 {StdinProc} {unix} { +test main-1.1 {StdinProc} -constraints stdio -setup { set script [makeFile { close stdin; exit } script] - if {[catch {exec [interpreter] <$script} msg]} { - set error 1 - } else { - set error 0 - } +} -body { + list [catch {exec [interpreter] <$script} msg] $msg +} -cleanup { removeFile script - list $error $msg -} {0 {}} +} -result {0 {}} + +test main-2.1 {Tk_MainEx: -encoding option} -constraints { + stdio + } -setup { + set script [makeFile {} script] + removeFile script + set f [open $script w] + fconfigure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]; exit" + close $f + catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]} + } -body { + read $f + } -cleanup { + close $f + removeFile script + } -result [list script {} 0]\n1\n + +test main-2.2 {Tk_MainEx: -encoding option} -constraints { + stdio + } -setup { + set script [makeFile {} script] + removeFile script + set f [open $script w] + fconfigure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]; exit" + close $f + catch {set f [open "|[list [interpreter] -encoding ascii script]" r]} + } -body { + read $f + } -cleanup { + close $f + removeFile script + } -result [list script {} 0]\n0\n + + # Procedure to simulate interactive typing of commands, line by line + proc type {chan script} { + foreach line [split $script \n] { + if {[catch { + puts $chan $line + flush $chan + }]} { + return + } + # Grrr... Behavior depends on this value. + after 1000 + } + } + +test main-2.3 {Tk_MainEx: -encoding option} -constraints { + stdio + } -setup { + set script [makeFile {} script] + removeFile script + set f [open $script w] + fconfigure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]" + close $f + catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]} + } -body { + type $f { + puts $argv + exit + } + list [catch {gets $f} line] $line + } -cleanup { + close $f + removeFile script + } -result {0 {-enc utf-8 script}} # cleanup cleanupTests |