From d7be6d4cec335a1347fae7694ed8a6be6ddcf1b5 Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 27 Oct 2007 04:11:46 +0000 Subject: merge updates from HEAD --- ChangeLog | 74 +++++++++++++--- README | 2 +- changes | 14 +++- doc/man.macros | 213 +++++++++++++++++++++++++++-------------------- generic/tcl.h | 2 +- generic/tclCompile.h | 8 +- generic/tclThread.c | 11 ++- generic/tclVar.c | 152 +++++++++++++++++++++------------ library/init.tcl | 2 +- tools/man2help.tcl | 5 +- tools/man2help2.tcl | 61 ++++++++++---- tools/man2html2.tcl | 45 +++++++++- tools/man2tcl.c | 30 ++++++- tools/tcltk-man2html.tcl | 70 +++++++++++++--- unix/configure.in | 2 +- unix/tcl.spec | 2 +- unix/tclConfig.h.in | 3 - win/configure.in | 2 +- 18 files changed, 495 insertions(+), 203 deletions(-) diff --git a/ChangeLog b/ChangeLog index e3228d9..7b7c81c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,57 @@ +2007-10-27 Miguel Sofer + + * generic/tclVar.c: try to preserve Tcl_Objs when doing variable + lookups by name, partially addressing [Bug 1793601] + +2007-10-27 Donal K. Fellows + + * tools/tcltk-man2html.tcl (make-man-pages, htmlize-text) + (process-text): Make the man->HTML scraper work better. + +2007-10-26 Don Porter + + *** 8.5b2 TAGGED FOR RELEASE *** + + * changes: Updated for 8.5b2 release. + + * doc/*.1: Revert doc changes that broke + * doc/*.3: `make html` so we can get the release + * doc/*.n: out the door. + + * README: Bump version number to 8.5b2. + * generic/tcl.h: + * library/init.tcl: + * tools/tcl.wse.in: + * unix/configure.in: + * unix/tcl.spec: + * win/configure.in: + + * unix/configure: autoconf (2.59) + * win/configure: + +2007-10-26 Donal K. Fellows + + * tools/man2help2.tcl, tools/man2tcl.c: Made some of the tooling code + to do man->other formats work better with current manpage set. Long + way still to go. + +2007-10-25 Zoran Vasiljevic + + * generic/tclThread.c: Added TclpMasterLock/Unlock arround calls to + ForgetSyncObject in Tcl_MutexFinalize and Tcl_ConditionFinalize to + prevent from garbling the internal lists that track sync objects. [Bug + 1726873] + +2007-10-24 Donal K. Fellows + + * tools/man2html2.tcl (macro): Added support for converting the new + macros into HTML. + + * doc/man.macros (QW,PQ,QR,MT): New macros that hide the ugly mess + needed to get proper GOOBE quoting in the manual pages. + * doc/*.n, doc/*.3, doc/*.1: Lots of changes to take advantage of the + new macros. + 2007-10-20 Miguel Sofer * generic/tclCompile.c: Fix comments. @@ -5,8 +59,8 @@ 2007-10-18 David Gravereaux - * tools/mkdepend.tcl: sort the dep list for a more humanly - readable output. + * tools/mkdepend.tcl: sort the dep list for a more humanly readable + output. 2007-10-18 Don Porter @@ -14,14 +68,14 @@ values get pulled out of the dictionary, even if they are integer valued. - * generic/tclCompCmds.c (TclCompileReturnCmd): Added code to - more optimally compile [return -level 0 $x] to "push $x". [RFE 1794073] + * generic/tclCompCmds.c (TclCompileReturnCmd): Added code to more + optimally compile [return -level 0 $x] to "push $x". [RFE 1794073] * compat/tmpnam.c (removed): The routine tmpnam() is no longer - * unix/Makefile.in: called by Tcl source code. Remove autogoo - * unix/configure.in: the supplied a replacement version on - * win/tcl.dsp: systems where the routine was not available. - [RFE 1811848]. + * unix/Makefile.in: called by Tcl source code. Remove autogoo the + * unix/configure.in: supplied a replacement version on systems + * win/tcl.dsp: where the routine was not available. [RFE + 1811848] * unix/configure: autoconf-2.59 @@ -29,8 +83,8 @@ 2007-10-17 David Gravereaux - * tools/mkdepend.tcl: Improved defense from malformed object - list infile. + * tools/mkdepend.tcl: Improved defense from malformed object list + infile. 2007-10-17 Donal K. Fellows diff --git a/README b/README index 03a4f44..69af1e6 100644 --- a/README +++ b/README @@ -5,7 +5,7 @@ README: Tcl You can get any source release of Tcl from the file distributions link at the above URL. -RCS: @(#) $Id: README,v 1.59.2.3 2007/10/02 20:11:45 dgp Exp $ +RCS: @(#) $Id: README,v 1.59.2.4 2007/10/27 04:11:46 dgp Exp $ Contents -------- diff --git a/changes b/changes index 3842e01..7686a77 100644 --- a/changes +++ b/changes @@ -1,6 +1,6 @@ Recent user-visible changes to Tcl: -RCS: @(#) $Id: changes,v 1.116.2.2 2007/10/02 20:11:45 dgp Exp $ +RCS: @(#) $Id: changes,v 1.116.2.3 2007/10/27 04:11:46 dgp Exp $ 1. No more [command1] [command2] construct for grouping multiple commands on a single command line. @@ -7024,3 +7024,15 @@ project for Xcode 3.0 (steffen) on Windows to be larger than the default [interp recursionlimit] value. --- Released 8.5b1, September 26, 2007 --- See ChangeLog for details --- + +2007-10-02 (bug fix)[1806422] proper [tcl::tm::path] autoload (porter) + +2007-10-02 (bug fix) Improve Tcl_DecrRefCount() robustness (staplin) + +2007-10-11 (bug fix)[1805887] [string is int -failindex] for 0o, 0b (porter) + +2007-10-15 (bug fix)[1813528] Tcl_ParseBraces read past buffer (mistachkin) + +2007-10-25 (bug fix)[1726873] intermittent crash in threads (vasiljevic) + +--- Released 8.5b2, October 26, 2007 --- See ChangeLog for details --- diff --git a/doc/man.macros b/doc/man.macros index 29b8a51..bb5797a 100644 --- a/doc/man.macros +++ b/doc/man.macros @@ -1,72 +1,80 @@ -'\" The definitions below are for supplemental macros used in Tcl/Tk -'\" manual entries. -'\" -'\" .AP type name in/out ?indent? -'\" Start paragraph describing an argument to a library procedure. -'\" type is type of argument (int, etc.), in/out is either "in", "out", -'\" or "in/out" to describe whether procedure reads or modifies arg, -'\" and indent is equivalent to second arg of .IP (shouldn't ever be -'\" needed; use .AS below instead) -'\" -'\" .AS ?type? ?name? ?in|out|in/out? -'\" Give maximum sizes of arguments for setting tab stops. Type and -'\" name are examples of largest possible arguments that will be passed -'\" to .AP later. If args are omitted, default tab stops are used. If -'\" the third arg is not supplied, "in" is assumed. -'\" -'\" .BS -'\" Start box enclosure. From here until next .BE, everything will be -'\" enclosed in one large box. -'\" -'\" .BE -'\" End of box enclosure. -'\" -'\" .CS -'\" Begin code excerpt. -'\" -'\" .CE -'\" End code excerpt. -'\" -'\" .VS ?version? ?br? -'\" Begin vertical sidebar, for use in marking newly-changed parts -'\" of man pages. The first argument is ignored and used for recording -'\" the version when the .VS was added, so that the sidebars can be -'\" found and removed when they reach a certain age. If another argument -'\" is present, then a line break is forced before starting the sidebar. -'\" -'\" .VE -'\" End of vertical sidebar. -'\" -'\" .DS -'\" Begin an indented unfilled display. -'\" -'\" .DE -'\" End of indented unfilled display. -'\" -'\" .SO -'\" Start of list of standard options for a Tk widget. The -'\" options follow on successive lines, in four columns separated -'\" by tabs. -'\" -'\" .SE -'\" End of list of standard options for a Tk widget. -'\" -'\" .OP cmdName dbName dbClass -'\" Start of description of a specific option. cmdName gives the -'\" option's name as specified in the class command, dbName gives -'\" the option's name in the option database, and dbClass gives -'\" the option's class in the option database. -'\" -'\" .UL arg1 arg2 -'\" Print arg1 underlined, then print arg2 normally. -'\" -'\" RCS: @(#) $Id: man.macros,v 1.5 2004/10/07 14:44:35 dkf Exp $ -'\" -'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO +.\" Start of list of standard options for a Tk widget. The +.\" options follow on successive lines, in three columns separated +.\" by tabs. +.\" +.\" .SE ?manpage? +.\" End of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" RCS: @(#) $Id: man.macros,v 1.5.12.1 2007/10/27 04:11:46 dgp Exp $ +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. .if t .wh -1.3i ^B .nr ^l \n(.l .ad b -'\" # Start an argument description +.\" # Start an argument description .de AP .ie !"\\$4"" .TP \\$4 .el \{\ @@ -88,20 +96,19 @@ .\} .\} .. -'\" # define tabbing values for .AP +.\" # define tabbing values for .AP .de AS .nr )A 10n -.if !"\\$1"" .nr )A \\w'\\$1'u+1n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n .nr )B \\n()Au+15n .\" -.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+2n -.ie !"\\$3"" .nr )C \\n()Bu+\\w'(\\$3)'u+2n -.el .nr )C \\n()Bu+\\w'(in)'u+2n +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n .. .AS Tcl_Interp Tcl_CreateInterp in/out -'\" # BS - start boxed text -'\" # ^y = starting y location -'\" # ^b = 1 +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 .de BS .br .mk ^y @@ -111,7 +118,7 @@ .if n \l'\\n(.lu\(ul' .if n .fi .. -'\" # BE - end boxed text (draw box now) +.\" # BE - end boxed text (draw box now) .de BE .nf .ti 0 @@ -131,16 +138,16 @@ .br .nr ^b 0 .. -'\" # VS - start vertical sidebar -'\" # ^Y = starting y location -'\" # ^v = 1 (for troff; for nroff this doesn't matter) +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) .de VS .if !"\\$2"" .br .mk ^Y .ie n 'mc \s12\(br\s0 .el .nr ^v 1u .. -'\" # VE - end of vertical sidebar +.\" # VE - end of vertical sidebar .de VE .ie n 'mc .el \{\ @@ -155,9 +162,9 @@ .\} .nr ^v 0 .. -'\" # Special macro to handle page bottom: finish off current -'\" # box/sidebar if in box/sidebar mode, then invoked standard -'\" # page bottom macro. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. .de ^B .ev 2 'ti 0 @@ -184,19 +191,19 @@ .mk ^Y .\} .. -'\" # DS - begin display +.\" # DS - begin display .de DS .RS .nf .sp .. -'\" # DE - end display +.\" # DE - end display .de DE .fi .RE .sp .. -'\" # SO - start of list of standard options +.\" # SO - start of list of standard options .de SO .SH "STANDARD OPTIONS" .LP @@ -204,14 +211,17 @@ .ta 5.5c 11c .ft B .. -'\" # SE - end of list of standard options +.\" # SE - end of list of standard options .de SE .fi .ft R .LP -See the \\fBoptions\\fR manual entry for details on the standard options. +See the +.ie '\\$1'' \\fBoptions\\fR +.el \\fB\\$1\\fR +manual entry for details on the standard options. .. -'\" # OP - start of full description for a single option +.\" # OP - start of full description for a single option .de OP .LP .nf @@ -222,17 +232,40 @@ Database Class: \\fB\\$3\\fR .fi .IP .. -'\" # CS - begin code excerpt +.\" # CS - begin code excerpt .de CS .RS .nf .ta .25i .5i .75i 1i .. -'\" # CE - end code excerpt +.\" # CE - end code excerpt .de CE .fi .RE .. +.\" # UL - underline word .de UL \\$1\l'|0\(ul'\\$2 .. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. diff --git a/generic/tcl.h b/generic/tcl.h index 8c4bbbb..284621b 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -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: tcl.h,v 1.231.2.9 2007/10/19 14:30:01 dgp Exp $ + * RCS: @(#) $Id: tcl.h,v 1.231.2.10 2007/10/27 04:11:47 dgp Exp $ */ #ifndef _TCL diff --git a/generic/tclCompile.h b/generic/tclCompile.h index c05ba70..069a0ba 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.h,v 1.70.2.8 2007/10/02 20:11:55 dgp Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.70.2.9 2007/10/27 04:11:47 dgp Exp $ */ #ifndef _TCLCOMPILATION @@ -624,9 +624,9 @@ typedef struct ByteCode { * [namespace upvar]. */ -#define INST_UPVAR 122 -#define INST_NSUPVAR 123 -#define INST_VARIABLE 124 +#define INST_UPVAR 122 +#define INST_NSUPVAR 123 +#define INST_VARIABLE 124 /* Instruction to support compiling syntax error to bytecode */ diff --git a/generic/tclThread.c b/generic/tclThread.c index 04d03d5..79f5199 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclThread.c,v 1.16.2.1 2007/07/01 17:31:25 dgp Exp $ + * RCS: @(#) $Id: tclThread.c,v 1.16.2.2 2007/10/27 04:11:47 dgp Exp $ */ #include "tclInt.h" @@ -142,6 +142,8 @@ TclThreadDataKeyGet( * Keep a list of (mutexes/condition variable/data key) used during * finalization. * + * Assume master lock is held. + * * Results: * None. * @@ -201,6 +203,7 @@ RememberSyncObject( * ForgetSyncObject * * Remove a single object from the list. + * Assume master lock is held. * * Results: * None. @@ -232,6 +235,7 @@ ForgetSyncObject( * TclRememberMutex * * Keep a list of mutexes used during finalization. + * Assume master lock is held. * * Results: * None. @@ -273,7 +277,9 @@ Tcl_MutexFinalize( #ifdef TCL_THREADS TclpFinalizeMutex(mutexPtr); #endif + TclpMasterLock(); ForgetSyncObject((char *) mutexPtr, &mutexRecord); + TclpMasterUnlock(); } /* @@ -282,6 +288,7 @@ Tcl_MutexFinalize( * TclRememberCondition * * Keep a list of condition variables used during finalization. + * Assume master lock is held. * * Results: * None. @@ -323,7 +330,9 @@ Tcl_ConditionFinalize( #ifdef TCL_THREADS TclpFinalizeCondition(condPtr); #endif + TclpMasterLock(); ForgetSyncObject((char *) condPtr, &condRecord); + TclpMasterUnlock(); } /* diff --git a/generic/tclVar.c b/generic/tclVar.c index c92ec2a..a460f10 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.135.2.7 2007/09/09 04:14:28 dgp Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.135.2.8 2007/10/27 04:11:47 dgp Exp $ */ #include "tclInt.h" @@ -148,6 +148,8 @@ static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr, static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr); static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr, Var *varPtr, int flags); +static Tcl_Var ObjFindNamespaceVar(Tcl_Interp *interp, Tcl_Obj *namePtr, + Tcl_Namespace *contextNsPtr, int flags); static int ObjMakeUpvar(Tcl_Interp *interp, CallFrame *framePtr, Tcl_Obj *otherP1Ptr, const char *otherP2, const int otherFlags, @@ -504,43 +506,10 @@ TclObjLookupVarEx( char *part2 = part2Ptr? TclGetString(part2Ptr):NULL; char *newPart2 = NULL; - /* - * If part1Ptr is a tclParsedVarNameType, separate it into the pre-parsed - * parts. - */ - *arrayPtrPtr = NULL; - if (typePtr == &tclParsedVarNameType) { - if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) { - if (part2Ptr != NULL) { - /* - * ERROR: part1Ptr is already an array element, cannot specify - * a part2. - */ - - if (flags & TCL_LEAVE_ERR_MSG) { - TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, - needArray, -1); - } - return NULL; - } - part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2; - if (newPart2) { - part2Ptr = Tcl_NewStringObj(newPart2, -1); - Tcl_IncrRefCount(part2Ptr); - } - part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1; - typePtr = part1Ptr->typePtr; - } - parsed = 1; - } - part1 = Tcl_GetStringFromObj(part1Ptr, &len1); if (varFramePtr) { nsPtr = varFramePtr->nsPtr; - if (nsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) { - goto doParse; - } } else { /* * Some variables in the global ns have to be initialized before the @@ -548,12 +517,14 @@ TclObjLookupVarEx( */ nsPtr = NULL; - goto doParse; } if (typePtr == &localVarNameType) { - int localIndex = (int) part1Ptr->internalRep.ptrAndLongRep.value; + int localIndex; + + localVarNameTypeHandling: + localIndex = (int) part1Ptr->internalRep.ptrAndLongRep.value; if (HasLocalVars(varFramePtr) && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) && (localIndex < varFramePtr->numCompiledLocals)) { @@ -611,7 +582,40 @@ TclObjLookupVarEx( #endif } - doParse: + /* + * If part1Ptr is a tclParsedVarNameType, separate it into the pre-parsed + * parts. + */ + + if (typePtr == &tclParsedVarNameType) { + if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) { + if (part2Ptr != NULL) { + /* + * ERROR: part1Ptr is already an array element, cannot specify + * a part2. + */ + + if (flags & TCL_LEAVE_ERR_MSG) { + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, + needArray, -1); + } + return NULL; + } + part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2; + if (newPart2) { + part2Ptr = Tcl_NewStringObj(newPart2, -1); + Tcl_IncrRefCount(part2Ptr); + } + part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1; + typePtr = part1Ptr->typePtr; + if (typePtr == &localVarNameType) { + goto localVarNameTypeHandling; + } + } + parsed = 1; + } + part1 = Tcl_GetStringFromObj(part1Ptr, &len1); + if (!parsed && (*(part1 + len1 - 1) == ')')) { /* * part1Ptr is possibly an unparsed array element. @@ -778,7 +782,7 @@ TclObjLookupVarEx( * (Bug #835020) */ -#define LOOKUP_FOR_UPVAR 0x40000 +#define AVOID_RESOLVERS 0x40000 /* *---------------------------------------------------------------------- @@ -828,7 +832,7 @@ TclLookupSimpleVar( Tcl_Obj *varNamePtr, /* This is a simple variable name that could * represent a scalar or an array. */ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, - * LOOKUP_FOR_UPVAR and TCL_LEAVE_ERR_MSG bits + * AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG bits * matter. */ const int create, /* If 1, create hash table entry for varname, * if it doesn't already exist. If 0, return @@ -869,7 +873,7 @@ TclLookupSimpleVar( */ if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) - && !(flags & LOOKUP_FOR_UPVAR)) { + && !(flags & AVOID_RESOLVERS)) { resPtr = iPtr->resolverPtr; if (cxtNsPtr->varResProc) { result = (*cxtNsPtr->varResProc)(interp, varName, @@ -921,11 +925,10 @@ TclLookupSimpleVar( || ((*varName == ':') && (*(varName+1) == ':')); if (lookGlobal) { *indexPtr = -1; - flags = (flags | TCL_GLOBAL_ONLY) & - ~(TCL_NAMESPACE_ONLY | LOOKUP_FOR_UPVAR); + flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY; } else { - if (flags & LOOKUP_FOR_UPVAR) { - flags = (flags | TCL_NAMESPACE_ONLY) & ~LOOKUP_FOR_UPVAR; + if (flags & AVOID_RESOLVERS) { + flags = (flags | TCL_NAMESPACE_ONLY); } if (flags & TCL_NAMESPACE_ONLY) { *indexPtr = -2; @@ -937,9 +940,8 @@ TclLookupSimpleVar( * otherwise generate our own error! */ - varPtr = (Var *) Tcl_FindNamespaceVar(interp, varName, - (Tcl_Namespace *) cxtNsPtr, flags & ~TCL_LEAVE_ERR_MSG); - + varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr, + (Tcl_Namespace *) cxtNsPtr, (flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG); if (varPtr == NULL) { Tcl_Obj *tailPtr; @@ -3562,7 +3564,7 @@ TclPtrObjMakeUpvar( /* * Lookup and eventually create the new variable. Set the flag bit - * LOOKUP_FOR_UPVAR to indicate the special resolution rules for upvar + * AVOID_RESOLVERS to indicate the special resolution rules for upvar * purposes: * - Bug #696893 - variable is either proc-local or in the current * namespace; never follow the second (global) resolution path. @@ -3570,7 +3572,7 @@ TclPtrObjMakeUpvar( */ varPtr = TclLookupSimpleVar(interp, myNamePtr, - (myFlags|LOOKUP_FOR_UPVAR), /* create */ 1, &errMsg, &index); + (myFlags|AVOID_RESOLVERS), /* create */ 1, &errMsg, &index); if (varPtr == NULL) { TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1); return TCL_ERROR; @@ -4841,7 +4843,38 @@ Tcl_FindNamespaceVar( * Otherwise, points to namespace in which to * resolve name. If NULL, look up name in the * current namespace. */ - int flags) /* An OR'd combination of flags: + int flags) /* An OR'd combination of: AVOID_RESOLVERS, + * TCL_GLOBAL_ONLY (look up name only in + * global namespace), TCL_NAMESPACE_ONLY (look + * up only in contextNsPtr, or the current + * namespace if contextNsPtr is NULL), and + * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY + * and TCL_NAMESPACE_ONLY are given, + * TCL_GLOBAL_ONLY is ignored. */ +{ + Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1); + Tcl_Var var; + + Tcl_IncrRefCount(namePtr); + var = ObjFindNamespaceVar(interp, namePtr, contextNsPtr, flags); + Tcl_DecrRefCount(namePtr); + return var; +} + +static Tcl_Var +ObjFindNamespaceVar( + Tcl_Interp *interp, /* The interpreter in which to find the + * variable. */ + Tcl_Obj *namePtr, /* Variable's name. If it starts with "::", + * will be looked up in global namespace. + * Else, looked up first in contextNsPtr + * (current namespace if contextNsPtr is + * NULL), then in global namespace. */ + Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set. + * Otherwise, points to namespace in which to + * resolve name. If NULL, look up name in the + * current namespace. */ + int flags) /* An OR'd combination of: AVOID_RESOLVERS, * TCL_GLOBAL_ONLY (look up name only in * global namespace), TCL_NAMESPACE_ONLY (look * up only in contextNsPtr, or the current @@ -4859,7 +4892,8 @@ Tcl_FindNamespaceVar( int result; Tcl_Var var; Tcl_Obj *simpleNamePtr; - + char *name = TclGetString(namePtr); + /* * If this namespace has a variable resolver, then give it first crack at * the variable resolution. It may return a Tcl_Var value, it may signal @@ -4874,7 +4908,8 @@ Tcl_FindNamespaceVar( cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp); } - if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) { + if (!(flags & AVOID_RESOLVERS) && + (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) { resPtr = iPtr->resolverPtr; if (cxtNsPtr->varResProc) { @@ -4913,14 +4948,21 @@ Tcl_FindNamespaceVar( */ varPtr = NULL; - simpleNamePtr = Tcl_NewStringObj(simpleName, -1); - Tcl_IncrRefCount(simpleNamePtr); + if (simpleName != name) { + simpleNamePtr = Tcl_NewStringObj(simpleName, -1); + Tcl_IncrRefCount(simpleNamePtr); + } else { + simpleNamePtr = namePtr; + } + for (search = 0; (search < 2) && (varPtr == NULL); search++) { if ((nsPtr[search] != NULL) && (simpleName != NULL)) { varPtr = VarHashFindVar(&nsPtr[search]->varTable, simpleNamePtr); } } - Tcl_DecrRefCount(simpleNamePtr); + if (simpleName != name) { + Tcl_DecrRefCount(simpleNamePtr); + } if (varPtr != NULL) { return (Tcl_Var) varPtr; } else if (flags & TCL_LEAVE_ERR_MSG) { diff --git a/library/init.tcl b/library/init.tcl index e456f3c..4c2d646 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -3,7 +3,7 @@ # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # -# RCS: @(#) $Id: init.tcl,v 1.91.2.4 2007/10/02 20:11:58 dgp Exp $ +# RCS: @(#) $Id: init.tcl,v 1.91.2.5 2007/10/27 04:11:47 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. diff --git a/tools/man2help.tcl b/tools/man2help.tcl index 91fcb89..b7404b9 100644 --- a/tools/man2help.tcl +++ b/tools/man2help.tcl @@ -6,14 +6,15 @@ # # Copyright (c) 1996 by Sun Microsystems, Inc. # -# RCS: @(#) $Id: man2help.tcl,v 1.14 2003/06/04 23:40:18 mistachkin Exp $ +# RCS: @(#) $Id: man2help.tcl,v 1.14.12.1 2007/10/27 04:11:48 dgp Exp $ # # # PASS 1 # -set man2tclprog [file join [file dirname [info script]] man2tcl.exe] +set man2tclprog [file join [file dirname [info script]] \ + man2tcl[file extension [info nameofexecutable]]] proc generateContents {basename version files} { global curID topics diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl index 62b5b2e..a5ec3a9 100644 --- a/tools/man2help2.tcl +++ b/tools/man2help2.tcl @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: man2help2.tcl,v 1.15 2004/07/07 12:08:43 dkf Exp $ +# RCS: @(#) $Id: man2help2.tcl,v 1.15.12.1 2007/10/27 04:11:48 dgp Exp $ # # Global variables used by these scripts: @@ -425,6 +425,21 @@ proc macro {name args} { } VE {} VS {} + QW { + formattedText "``[lindex $args 0]''[lindex $args 1] " + } + MT { + text "``'' " + } + PQ { + formattedText \ + "(``[lindex $args 0]''[lindex $args 1])[lindex $args 2] " + } + QR { + formattedText "``[lindex $args 0]" + dash + formattedText "[lindex $args 1]''[lindex $args 2] " + } default { puts stderr "Unknown macro: .$name [join $args " "]" } @@ -516,13 +531,12 @@ proc formattedText {text} { dash set text [string range $text [expr {$index+2}] end] } - | { + & - | { set text [string range $text [expr {$index+2}] end] } - o { - text "\\'" - regexp {'([^']*)'(.*)} $text all ch text - text $chars($ch) + ( { + char [string range $text $index [expr {$index+3}]] + set text [string range $text [expr {$index+4}] end] } default { puts stderr "Unknown sequence: \\$c" @@ -665,32 +679,51 @@ proc char {name} { global file state switch -exact $name { - \\o { + {\o} { set state(intl) 1 } - \\\ { + {\ } { textSetup puts -nonewline $file " " } - \\0 { + {\0} { textSetup puts -nonewline $file " \\emspace " } - \\\\ { + {\\} - {\e} { textSetup puts -nonewline $file "\\\\" } - \\(+- { + {\(+-} { textSetup puts -nonewline $file "\\'b1 " } - \\% - - \\| { + {\%} - {\|} { } - \\(bu { + {\(->} { + textSetup + puts -nonewline $file "->" + } + {\(bu} { textSetup puts -nonewline $file "\\bullet " } + {\(co} { + textSetup + puts -nonewline $file "\\'a9 " + } + {\(mu} { + textSetup + puts -nonewline $file "\\'d7 " + } + {\(em} { + textSetup + puts -nonewline $file "-" + } + {\(fm} { + textSetup + puts -nonewline $file "\\'27 " + } default { puts stderr "Unknown character: $name" } diff --git a/tools/man2html2.tcl b/tools/man2html2.tcl index d1887b5..9415044 100644 --- a/tools/man2html2.tcl +++ b/tools/man2html2.tcl @@ -6,7 +6,7 @@ # # Copyright (c) 1996 by Sun Microsystems, Inc. # -# $Id: man2html2.tcl,v 1.9.8.1 2007/10/19 14:30:02 dgp Exp $ +# $Id: man2html2.tcl,v 1.9.8.2 2007/10/27 04:11:49 dgp Exp $ # package require Tcl 8.4 @@ -308,7 +308,11 @@ proc macro {name args} { font B set temp $textState set textState REF - text options + if {[llength $args] > 0} { + text [lindex $args 0] + } else { + text options + } set textState $temp font R text " manual entry for detailed descriptions of the above options." @@ -374,6 +378,43 @@ proc macro {name args} { # } # puts -nonewline $file "" } + QW { + puts -nonewline $file "&\#147;" + text [lindex $args 0] + puts -nonewline $file "&\#148;" + if {[llength $args] > 1} { + text [lindex $args 1] + } + } + PQ { + puts -nonewline $file "(&\#147;" + if {[lindex $args 0] eq {\N'34'}} { + puts -nonewline $file \" + } else { + text [lindex $args 0] + } + puts -nonewline $file "&\#148;" + if {[llength $args] > 1} { + text [lindex $args 1] + } + puts -nonewline $file ")" + if {[llength $args] > 2} { + text [lindex $args 2] + } + } + QR { + puts -nonewline $file "&\#147;" + text [lindex $args 0] + puts -nonewline $file "&\#148;&\#150;&\#147;" + text [lindex $args 1] + puts -nonewline $file "&\#148;" + if {[llength $args] > 2} { + text [lindex $args 2] + } + } + MT { + puts -nonewline $file "&\#147;&\#148;" + } default { puts stderr "Unknown macro: .$name [join $args " "]" } diff --git a/tools/man2tcl.c b/tools/man2tcl.c index a90b729..9bad547 100644 --- a/tools/man2tcl.c +++ b/tools/man2tcl.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: man2tcl.c,v 1.11 2007/01/19 08:17:35 mistachkin Exp $ + * RCS: @(#) $Id: man2tcl.c,v 1.11.2.1 2007/10/27 04:11:51 dgp Exp $ */ static char sccsid[] = "@(#) man2tcl.c 1.3 95/08/12 17:34:08"; @@ -329,6 +329,9 @@ DoText( p++; } else if (*p == '&') { p++; + } else if (*p == '0') { + PRINT(("text { }\n")); + p++; } else if (*p == '(') { if ((p[1] == 0) || (p[2] == 0)) { fprintf(stderr, "Bad \\( sequence on line %d.\n", @@ -338,6 +341,13 @@ DoText( PRINT(("char {\\(%c%c}\n", p[1], p[2])); p += 3; } + } else if (*p == 'N' && *(p+1) == '\'') { + int ch; + + p += 2; + sscanf(p,"%d",&ch); + PRINT(("text \\u%04x", ch)); + while(*p&&*p!='\'') p++; } else if (*p != 0) { PRINT(("char {\\%c}\n", *p)); p++; @@ -377,7 +387,23 @@ QuoteText( } for ( ; count > 0; string++, count--) { switch (*string) { - case '$': case '[': case '{': case ' ': case ';': case '\\': + case '\\': + if (*(string+1) == 'N' && *(string+2) == '\'') { + int ch; + + string += 3; + count -= 3; + sscanf(string,"%d",&ch); + PRINT(("\\u%04x", ch)); + while(count>0&&*string!='\'') {string++;count--;} + continue; + } else if (*(string+1) == '0') { + PRINT(("\\ ")); + string++; + count--; + continue; + } + case '$': case '[': case '{': case ' ': case ';': case '"': case '\t': PRINTC('\\'); default: diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index a107067..b71602c 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -179,7 +179,7 @@ proc copyright {copyright {level {}}} { #return "Copyright © [htmlize-text [lrange $copyright 2 end]]" # obfuscate any email addresses that may appear in name set who [string map {@ (at)} [lrange $copyright 2 end]] - return "Copyright © [htmlize-text $who]" + return "Copyright © [htmlize-text $who]" } proc copyout {copyrights {level {}}} { set out "
" @@ -325,7 +325,10 @@ proc htmlize-text {text {charmap {}}} { {\0} { } \ \" {"} \ {<} {<} \ - {>} {>} + {>} {>} \ + \u201c "“" \ + \u201d "”" + return [string map $charmap $text] } @@ -337,6 +340,11 @@ proc process-text {text} { {\%} {} \ "\\\n" "\n" \ {\(+-} "±" \ + {\(co} "©" \ + {\(em} "—" \ + {\(fm} "′" \ + {\(mu} "×" \ + {\(->} "→" \ {\fP} {\fR} \ {\.} . \ {\(bu} "•" \ @@ -346,6 +354,8 @@ proc process-text {text} { lappend charmap {\-} - ; # a hyphen set text [htmlize-text $text $charmap] + # General quoted entity + regsub -all {\\N'(\d+)'} $text "\\&#\\1;" text while {[string first "\\" $text] >= 0} { # C R if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \ @@ -678,10 +688,7 @@ proc output-IP-list {context code rest} { } } } - .sp - - .br - - .DS - - .CS { + .sp - .br - .DS - .CS { output-directive $line } .RS { @@ -1063,8 +1070,7 @@ proc output-directive {line} { # process format directive split-directive $line code rest switch -exact $code { - .BS - - .BE { + .BS - .BE { # man-puts
} .SH - .SS { @@ -1368,7 +1374,8 @@ proc output-directive {line} { ## merge copyright listings ## proc merge-copyrights {l1 l2} { - set re1 {^Copyright +\(c\) +(\w.*?)(?:all rights reserved)?(?:\. )*$} + set merge {} + set re1 {^Copyright +(?:\(c\)|\\\(co|©) +(\w.*?)(?:all rights reserved)?(?:\. )*$} set re2 {^(\d+) +(?:by +)?(\w.*)$} ;# date who set re3 {^(\d+)-(\d+) +(?:by +)?(\w.*)$} ;# from to who set re4 {^(\d+), *(\d+) +(?:by +)?(\w.*)$} ;# date1 date2 who @@ -1393,9 +1400,9 @@ proc merge-copyrights {l1 l2} { foreach who [array names dates] { set list [lsort -dictionary $dates($who)] if {[llength $list] == 1 || [lindex $list 0] == [lrange $list end end]} { - lappend merge "Copyright (c) [lindex $list 0] $who" + lappend merge "Copyright © [lindex $list 0] $who" } else { - lappend merge "Copyright (c) [lindex $list 0]-[lrange $list end end] $who" + lappend merge "Copyright © [lindex $list 0]-[lrange $list end end] $who" } } return [lsort -dictionary $merge] @@ -1460,6 +1467,8 @@ proc make-man-pages {html args} { set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]" } # set manual(pages) [lrange $manual(pages) 0 5] + set LQ \u201c + set RQ \u201d foreach manual(page) $manual(pages) { # whistle puts stderr "scanning page $manual(page)" @@ -1482,13 +1491,13 @@ proc make-man-pages {html args} { set manual(section-toc) {} set manual(section-toc-n) 1 set manual(copyrights) {} - lappend manual(copyrights) "Copyright (c) 1995-1997 Roger E. Critchlow Jr." + lappend manual(copyrights) "Copyright © 1995-1997 Roger E. Critchlow Jr." lappend manual(all-pages) $manual(wing-file)/$manual(tail) manreport 100 $manual(name) while {[gets $manual(infp) line] >= 0} { manreport 100 $line if {[regexp {^[`'][/\\]} $line]} { - if {[regexp {Copyright \(c\).*$} $line copyright]} { + if {[regexp {Copyright (?:\(c\)|\\\(co).*$} $line copyright]} { lappend manual(copyrights) $copyright } # comment @@ -1520,6 +1529,41 @@ proc make-man-pages {html args} { .TH { lappend manual(text) "$code [unquote $rest]" } + .QW { + set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] + set s $LQ[unquote [lindex $rest 0]]$RQ[unquote [lindex $rest 1]] + if {$manual(partial-text) == ""} { + set manual(partial-text) $s + } else { + append manual(partial-text) \n$s + } + } + .PQ { + set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] + set s ($LQ[unquote [lindex $rest 0]]$RQ[unquote [lindex $rest 1]])[unquote [lindex $rest 2]] + if {$manual(partial-text) == ""} { + set manual(partial-text) $s + } else { + append manual(partial-text) \n$s + } + } + .QR { + set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] + set s $LQ[unquote [lindex $rest 0]]-[unquote [lindex $rest 1]]$RQ[unquote [lindex $rest 2]] + if {$manual(partial-text) == ""} { + set manual(partial-text) $s + } else { + append manual(partial-text) \n$s + } + } + .MT { + set s $LQ$RQ + if {$manual(partial-text) == ""} { + set manual(partial-text) $s + } else { + append manual(partial-text) \n$s + } + } .HS - .UL - .ta { lappend manual(text) "$code [unquote $rest]" diff --git a/unix/configure.in b/unix/configure.in index a93ed61..913f4ef 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.157.2.7 2007/10/19 14:30:03 dgp Exp $ +# RCS: @(#) $Id: configure.in,v 1.157.2.8 2007/10/27 04:11:51 dgp Exp $ AC_INIT([tcl],[8.5]) AC_PREREQ(2.59) diff --git a/unix/tcl.spec b/unix/tcl.spec index 43dd1a8..6d8a3ce 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -1,4 +1,4 @@ -# $Id: tcl.spec,v 1.27.2.2 2007/10/02 20:12:08 dgp Exp $ +# $Id: tcl.spec,v 1.27.2.3 2007/10/27 04:11:51 dgp Exp $ # This file is the basis for a binary Tcl RPM for Linux. %{!?directory:%define directory /usr/local} diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index 5ed9eaf..75400b8 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -224,9 +224,6 @@ /* Should we use the global timezone variable? */ #undef HAVE_TIMEZONE_VAR -/* Define to 1 if you have the `tmpnam' function. */ -#undef HAVE_TMPNAM - /* Should we use the tm_gmtoff field of struct tm? */ #undef HAVE_TM_GMTOFF diff --git a/win/configure.in b/win/configure.in index 9211cd9..08dbbe6 100644 --- a/win/configure.in +++ b/win/configure.in @@ -3,7 +3,7 @@ # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.92.2.3 2007/10/02 20:12:09 dgp Exp $ +# RCS: @(#) $Id: configure.in,v 1.92.2.4 2007/10/27 04:11:51 dgp Exp $ AC_INIT(../generic/tcl.h) AC_PREREQ(2.59) -- cgit v0.12