ag/cpython-source-deps
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Import Tcl 8.6.11

Browse Source
This commit is contained in:
Steve Dower
2021-03-30 00:51:39 +01:00
parent 3bb8e3e086
commit 1aadb2455c
923 changed files with 79104 additions and 62616 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
tools/checkLibraryDoc.tcl
View File

@@ -3,7 +3,7 @@
# This script attempts to determine what APIs exist in the source base that
# have not been documented. By grepping through all of the doc/*.3 man
# pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list
# against the list of Pkg_ APIs found in the source (e.g., tcl8.2/*/*.[ch])
# against the list of Pkg_ APIs found in the source (e.g., tcl8.6/*/*.[ch])
# we create six lists:
# 1) APIs in Source not in Docs.
# 2) APIs in Docs not in Source.
@@ -16,7 +16,7 @@
# non-standard code, this script will produce erroneous results. Each
# list should be carefully checked for accuracy.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 Scriptics Corporation.
# All rights reserved.
@@ -69,6 +69,7 @@ set StructList {
Tk_GeomMgr \
Tk_Image \
Tk_ImageMaster \
Tk_ImageModel \
Tk_ImageType \
Tk_Item \
Tk_ItemType \
@@ -106,7 +107,6 @@ proc main {} {
if {($len != 2) && ($len != 3)} {
puts "usage: $argv0 pkgName pkgDir \[outFile\]"
puts " pkgName == Tcl,Tk"
puts " pkgDir == /home/surles/cvs/tcl8.2"
exit 1
}

2
tools/fix_tommath_h.tcl
View File

@@ -3,7 +3,7 @@
# Changes to 'tommath.h' to make it conform with Tcl's linking
# conventions.
#
# Copyright (c) 2005 by Kevin B. Kenny. All rights reserved.
# Copyright (c) 2005 Kevin B. Kenny. All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

16
tools/genStubs.tcl
View File

@@ -4,7 +4,7 @@
# interface.
#
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 Scriptics Corporation.
# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
@@ -479,11 +479,15 @@ proc genStubs::makeDecl {name decl index} {
if {[info exists stubs($name,deprecated,$index)]} {
append text "[string toupper $libraryName]_DEPRECATED(\"$stubs($name,deprecated,$index)\")\n"
set line "$rtype"
} elseif {[string range $rtype end-5 end] eq "MP_WUR"} {
set line "$scspec [string trim [string range $rtype 0 end-6]]"
} else {
set line "$scspec $rtype"
}
set count [expr {2 - ([string length $line] / 8)}]
append line [string range "\t\t\t" 0 $count]
if {$count >= 0} {
append line [string range "\t\t\t" 0 $count]
}
set pad [expr {24 - [string length $line]}]
if {$pad <= 0} {
append line " "
@@ -548,6 +552,9 @@ proc genStubs::makeDecl {name decl index} {
append line ")"
}
}
if {[string range $rtype end-5 end] eq "MP_WUR"} {
append line " MP_WUR"
}
return "$text$line;\n"
}
@@ -611,6 +618,8 @@ proc genStubs::makeSlot {name decl index} {
append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") "
} elseif {[string range $rtype 0 11] eq "TCL_NORETURN"} {
append text "TCL_NORETURN1 " [string trim [string range $rtype 12 end]] " (*" $lfname ") "
} elseif {[string range $rtype end-5 end] eq "MP_WUR"} {
append text [string trim [string range $rtype 0 end-6]] " (*" $lfname ") "
} else {
append text $rtype " (*" $lfname ") "
}
@@ -648,6 +657,9 @@ proc genStubs::makeSlot {name decl index} {
}
}
if {[string range $rtype end-5 end] eq "MP_WUR"} {
append text " MP_WUR"
}
append text "; /* $index */\n"
return $text
}

2
tools/index.tcl
View File

@@ -4,7 +4,7 @@
# the man page conversion. It is used to extract information used to
# generate a table of contents and a keyword list.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

6
tools/installData.tcl
View File

@@ -12,7 +12,7 @@ exec tclsh "$0" ${1+"$@"}
#
#----------------------------------------------------------------------
#
# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
# Copyright (c) 2004 Kevin B. Kenny. All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#----------------------------------------------------------------------
@@ -32,7 +32,7 @@ proc copyDir {d1 d2} {
} elseif {[file isfile $f]} {
file copy -force $f [file join $d2 $ftail]
if {$::tcl_platform(platform) eq {unix}} {
file attributes [file join $d2 $ftail] -permissions 0644
file attributes [file join $d2 $ftail] -permissions 0o644
} else {
file attributes [file join $d2 $ftail] -readonly 1
}
@@ -40,7 +40,7 @@ proc copyDir {d1 d2} {
}
if {$::tcl_platform(platform) eq {unix}} {
file attributes $d2 -permissions 0755
file attributes $d2 -permissions 0o755
} else {
file attributes $d2 -readonly 1
}

4
tools/loadICU.tcl
View File

@@ -22,7 +22,7 @@
#
#----------------------------------------------------------------------
#
# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
# Copyright (c) 2004 Kevin B. Kenny. All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#----------------------------------------------------------------------
@@ -588,7 +588,7 @@ proc backslashify { string } {
set retval {}
foreach char [split $string {}] {
scan $char %c ccode
if { $ccode >= 0x0020 && $ccode < 0x007f && $char ne "\""
if { $ccode >= 0x20 && $ccode < 0x7F && $char ne "\""
&& $char ne "\{" && $char ne "\}" && $char ne "\["
&& $char ne "\]" && $char ne "\\" && $char ne "\$" } {
append retval $char

2
tools/makeTestCases.tcl
View File

@@ -592,7 +592,7 @@ proc testcases5 { f2 } {
foreach { t offset isdst tzname } $row break
if { $t > -4000000000000 } {
set conds [list detroit]
if { $t > wide(0x7fffffff) } {
if { $t > wide(0x7FFFFFFF) } {
set conds [list detroit y2038]
}
incr t -1

2
tools/man2help.tcl
View File

@@ -4,7 +4,7 @@
# man2tcl program to generate a Windows help file from Tcl manual
# entries.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# PASS 1

6
tools/man2help2.tcl
View File

@@ -4,7 +4,7 @@
# the man page conversion. It converts the man format input to rtf
# form suitable for use by the Windows help compiler.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -157,7 +157,7 @@ proc text {string} {
"\t" {\tab } \
'' "\\rdblquote " \
`` "\\ldblquote " \
"\u00b7" "\\bullet " \
"\xB7" "\\bullet " \
] $string]
# Check if this is the beginning of an international character string.
@@ -824,7 +824,7 @@ proc IPmacro {argList} {
set indent 5
}
if {$text == {\(bu}} {
set text "\u00b7"
set text "\xB7"
}
set tab [expr {$indent * 0.1}]i

2
tools/man2html.tcl
View File

@@ -7,7 +7,7 @@ exec tclsh "$0" ${1+"$@"}
# This file contains procedures that work in conjunction with the
# man2tcl program to generate a HTML files from Tcl manual entries.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1996 Sun Microsystems, Inc.
# sarray -

2
tools/man2html1.tcl
View File

@@ -3,7 +3,7 @@
# This file defines procedures that are used during the first pass of the
# man page to html conversion process. It is sourced by h.tcl.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1996 Sun Microsystems, Inc.
# Global variables used by these scripts:
#

2
tools/man2html2.tcl
View File

@@ -4,7 +4,7 @@
# This file defines procedures that are used during the second pass of the man
# page to html conversion process. It is sourced by man2html.tcl.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1996 Sun Microsystems, Inc.
# Global variables used by these scripts:
#

4
tools/mkdepend.tcl
View File

@@ -88,7 +88,7 @@ proc readDepends {chan} {
set line ""
array set depends {}
while {[gets $chan line] != -1} {
while {[gets $chan line] >= 0} {
if {[regexp {^#line [0-9]+ \"(.*)\"$} $line dummy fname] != 0} {
set fname [file normalize $fname]
if {![info exists target]} {
@@ -98,7 +98,7 @@ proc readDepends {chan} {
} else {
# don't include ourselves as a dependency of ourself.
if {![string compare $fname $target]} {continue}
# store in an array so multiple occurances are not counted.
# store in an array so multiple occurrences are not counted.
set depends($target|$fname) ""
}
}

2
tools/regexpTestLib.tcl
View File

@@ -4,7 +4,7 @@
# spencer2regexp.tcl, which are programs written to convert Henry
# Spencer's test suite to tcl test files.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1996 Sun Microsystems, Inc.
proc readInputFile {} {
global inFileName

4
tools/tclZIC.tcl
View File

@@ -25,7 +25,7 @@
#
#----------------------------------------------------------------------
#
# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
# Copyright (c) 2004 Kevin B. Kenny. All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#----------------------------------------------------------------------
@@ -36,7 +36,7 @@
set olsonFiles {
africa antarctica asia australasia
backward etcetera europe northamerica
pacificnew southamerica systemv
southamerica
}
# Define the year at which the DST information will stop.

85
tools/tcltk-man2html-utils.tcl
View File

@@ -50,7 +50,7 @@ proc indexfile {} {
proc copyright {copyright {level {}}} {
# We don't actually generate a separate copyright page anymore
#set page "${level}copyright.htm"
#return "<A HREF=\"$page\">Copyright</A> &#169; [htmlize-text [lrange $copyright 2 end]]"
#return "<A HREF=\"$page\">Copyright</A> &copy; [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 &copy; [htmlize-text $who]"
@@ -130,8 +130,8 @@ proc htmlize-text {text {charmap {}}} {
\" {&quot;} \
{<} {&lt;} \
{>} {&gt;} \
\u201c "&#8220;" \
\u201d "&#8221;"
\u201c "&ldquo;" \
\u201d "&rdquo;"
return [string map $charmap $text]
}
@@ -144,20 +144,73 @@ proc process-text {text} {
{\&} "\t" \
{\%} {} \
"\\\n" "\n" \
{\(+-} "&#177;" \
{\(r!} "&iexcl;" \
{\(ct} "&cent;" \
{\(Po} "&pound;" \
{\(Cs} "&curren;" \
{\(Ye} "&yen;" \
{\(bb} "&brvbar;" \
{\(sc} "&sect;" \
{\(ad} "&die;" \
{\(co} "&copy;" \
{\(em} "&#8212;" \
{\(en} "&#8211;" \
{\(fm} "&#8242;" \
{\(mc} "&#181;" \
{\(mu} "&#215;" \
{\(mi} "&#8722;" \
{\(->} "<font size=\"+1\">&#8594;</font>" \
{\(Of} "&ordf;" \
{\(Fo} "&laquo;" \
{\(no} "&not;" \
{\(rg} "&reg;" \
{\(a-} "&macr;" \
{\(de} "&deg;" \
{\(+-} "&plusmn;" \
{\(S2} "&sup2;" \
{\(S3} "&sup3;" \
{\(aa} "&acute;" \
{\(mc} "&micro;" \
{\(ps} "&para;" \
{\(pc} "&middot;" \
{\(ac} "&cedil;" \
{\(S1} "&sup1;" \
{\(Om} "&ordm;" \
{\(Fc} "&raquo;" \
{\(14} "&frac14;" \
{\(12} "&frac12;" \
{\(34} "&frac34;" \
{\(r?} "&iquest;" \
{\(AE} "&AElig;" \
{\(-D} "&ETH;" \
{\(mu} "&times;" \
{\(TP} "&THORN;" \
{\(ss} "&szlig;" \
{\(ae} "&aelig;" \
{\(Sd} "&eth;" \
{\(di} "&divide;" \
{\(Tp} "&thorn;" \
{\(em} "&mdash;" \
{\(en} "&ndash;" \
{\(fm} "&prime;" \
{\(mi} "&minus;" \
{\(.i} "&imath;" \
{\(.j} "&jmath;" \
{\(Fn} "&fnof;" \
{\(OE} "&OElig;" \
{\(oe} "&oelig;" \
{\(IJ} "&IJlig;" \
{\(ij} "&ijlig;" \
{\(<-} "<font size=\"+1\">&larr;</font>" \
{\(->} "<font size=\"+1\">&rarr;</font>" \
{\(eu} "&euro;" \
{\fP} {\fR} \
{\.} . \
{\(bu} "&#8226;" \
{\(bu} "&bull;" \
{\*(qo} "&ocirc;" \
]
# This might make a few invalid mappings, but we don't use them
foreach c {a c e g i l n o s t u y z A C E G I L N O S T U Y Z} {
foreach {prefix suffix} {
o ring / slash : uml ' acute ^ circ ` grave ~ tilde , cedil v caron
} {
lappend charmap "\\\[${prefix}${c}\]" "&${c}${suffix};"
lappend charmap "\\(${prefix}${c}" "&${c}${suffix};"
}
}
lappend charmap {\-\|\-} -- ; # two hyphens
lappend charmap {\-} - ; # a hyphen
@@ -520,7 +573,7 @@ proc output-IP-list {context code rest} {
if {[regexp {^\[[\da-f]+\]|\(?[\da-f]+\)$} $rest]} {
set dl "<OL class=\"[string tolower $manual(section)]\">"
set enddl "</OL>"
} elseif {"&#8226;" eq $rest} {
} elseif {"&bull;" eq $rest} {
set dl "<UL class=\"[string tolower $manual(section)]\">"
set enddl "</UL>"
}
@@ -546,7 +599,7 @@ proc output-IP-list {context code rest} {
man-puts "$para<LI value=\"$value\">"
} elseif {[regexp {^\(?([\da-f]+)\)$} $rest -> value]} {
man-puts "$para<LI value=\"$value\">"
} elseif {"&#8226;" eq $rest} {
} elseif {"&bull;" eq $rest} {
man-puts "$para<LI>"
} else {
man-puts "$para<DT>[long-toc $rest]<DD>"
@@ -1559,6 +1612,10 @@ proc make-manpage-section {outputDir sectionDescriptor} {
puts stderr ""
}
if {![llength $manual(wing-toc)]} {
fatal "not table of contents."
}
#
# make the wing table of contents for the section
#

2
tools/tcltk-man2html.tcl
View File

@@ -557,6 +557,7 @@ array set remap_link_target {
Tk_Font Tk_GetFont
Tk_Image Tk_GetImage
Tk_ImageMaster Tk_GetImage
Tk_ImageModel Tk_GetImage
Tk_ItemType Tk_CreateItemType
Tk_Justify Tk_GetJustify
Ttk_Theme Ttk_GetTheme
@@ -586,6 +587,7 @@ array set exclude_refs_map {
scrollbar.n {set}
selection.n {string}
tcltest.n {error}
text.n {bind image lower raise}
tkvars.n {tk}
tkwait.n {variable}
tm.n {exec}

20
tools/uniClass.tcl
View File

@@ -16,33 +16,33 @@ proc emitRange {first last} {
global ranges numranges chars numchars extchars extranges
if {$first < ($last-1)} {
if {!$extranges && ($first) > 0xffff} {
if {!$extranges && ($first) > 0xFFFF} {
set extranges 1
set numranges 0
set ranges [string trimright $ranges " \n\r\t,"]
append ranges "\n#if CHRBITS > 16\n ,"
}
append ranges [format "{0x%x, 0x%x}, " \
append ranges [format "{0x%X, 0x%X}, " \
$first $last]
if {[incr numranges] % 4 == 0} {
set ranges [string trimright $ranges]
append ranges "\n "
}
} else {
if {!$extchars && ($first) > 0xffff} {
if {!$extchars && ($first) > 0xFFFF} {
set extchars 1
set numchars 0
set chars [string trimright $chars " \n\r\t,"]
append chars "\n#if CHRBITS > 16\n ,"
}
append chars [format "0x%x, " $first]
append chars [format "0x%X, " $first]
incr numchars
if {$numchars % 9 == 0} {
set chars [string trimright $chars]
append chars "\n "
}
if {$first != $last} {
append chars [format "0x%x, " $last]
append chars [format "0x%X, " $last]
incr numchars
if {$numchars % 9 == 0} {
append chars "\n "
@@ -63,11 +63,11 @@ proc genTable {type} {
set extchars 0
set extranges 0
for {set i 0} {$i <= 0x10ffff} {incr i} {
if {$i == 0xd800} {
# Skip surrogates
set i 0xe000
}
for {set i 0} {$i <= 0x10FFFF} {incr i} {
if {$i == 0xD800} {
# Skip surrogates
set i 0xE000
}
if {[string is $type [format %c $i]]} {
if {$i == ($last + 1)} {
set last $i

24
tools/uniParse.tcl
View File

@@ -6,7 +6,7 @@
# UnicodeData file from:
# ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData.txt
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 Scriptics Corporation.
# All rights reserved.
@@ -68,7 +68,7 @@ proc uni::getGroup {value} {
variable groups
set gIndex [lsearch -exact $groups $value]
if {$gIndex == -1} {
if {$gIndex < 0} {
set gIndex [llength $groups]
lappend groups $value
}
@@ -81,7 +81,7 @@ proc uni::addPage {info} {
variable shift
set pIndex [lsearch -exact $pages $info]
if {$pIndex == -1} {
if {$pIndex < 0} {
set pIndex [llength $pages]
lappend pages $info
}
@@ -114,8 +114,8 @@ proc uni::buildTables {data} {
set items [split $line \;]
scan [lindex $items 0] %x index
if {$index > 0x2ffff} then {
# Ignore non-BMP characters, as long as Tcl doesn't support them
if {$index > 0x3FFFF} then {
# Ignore characters > plane 3
continue
}
set index [format %d $index]
@@ -185,7 +185,7 @@ proc uni::main {} {
* automatically generated by the tools/uniParse.tcl script. Do not
* modify this file by hand.
*
* Copyright (c) 1998 by Scriptics Corporation.
* Copyright (c) 1998 Scriptics Corporation.
* All rights reserved.
*/
@@ -343,9 +343,9 @@ static const int groups\[\] = {"
puts -nonewline $f "};
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1fffff) >= [format 0x%x $next])
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= [format 0x%X $next])
#else
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1f0000) != 0)
# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0)
#endif
/*
@@ -392,8 +392,8 @@ enum {
* to do sign extension on right shifts.
*/
#define GetCaseType(info) (((info) & 0xe0) >> 5)
#define GetCategory(ch) (GetUniCharInfo(ch) & 0x1f)
#define GetCaseType(info) (((info) & 0xE0) >> 5)
#define GetCategory(ch) (GetUniCharInfo(ch) & 0x1F)
#define GetDelta(info) ((info) >> 8)
/*
@@ -402,9 +402,9 @@ enum {
*/
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
# define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1fffff) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
# define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1FFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
#else
# define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0xffff) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
# define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0xFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
#endif
"