diff options
author | welch <welch> | 1998-12-02 20:07:52 (GMT) |
---|---|---|
committer | welch <welch> | 1998-12-02 20:07:52 (GMT) |
commit | 32a79b2ff96bfafd432e5aa9c1de68fdaa028544 (patch) | |
tree | 43c0af64380a54e6b8326d1712821de3ed40d8bf /library | |
parent | 268b0e0536f8b73a091b695841708ebe48c4606b (diff) | |
download | tcl-32a79b2ff96bfafd432e5aa9c1de68fdaa028544.zip tcl-32a79b2ff96bfafd432e5aa9c1de68fdaa028544.tar.gz tcl-32a79b2ff96bfafd432e5aa9c1de68fdaa028544.tar.bz2 |
8.0.4 merge
Diffstat (limited to 'library')
-rw-r--r-- | library/auto.tcl | 10 | ||||
-rw-r--r-- | library/init.tcl | 3 | ||||
-rw-r--r-- | library/ldAout.tcl | 34 | ||||
-rw-r--r-- | library/package.tcl | 63 | ||||
-rw-r--r-- | library/safe.tcl | 8 | ||||
-rw-r--r-- | library/tclIndex | 41 |
6 files changed, 82 insertions, 77 deletions
diff --git a/library/auto.tcl b/library/auto.tcl index 6f5e4e6..075a5d2 100644 --- a/library/auto.tcl +++ b/library/auto.tcl @@ -3,7 +3,7 @@ # utility procs formerly in init.tcl dealing with auto execution # of commands and can be auto loaded themselves. # -# RCS: @(#) $Id: auto.tcl,v 1.1.2.4 1998/11/11 04:08:24 stanton Exp $ +# RCS: @(#) $Id: auto.tcl,v 1.1.2.5 1998/12/02 20:08:05 welch Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. @@ -119,10 +119,6 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} { } -# OPTIONAL SUPPORT PROCEDURES -# In Tcl 8.1 all the code below here has been moved to other files to -# reduce the size of init.tcl - # ---------------------------------------------------------------------- # auto_mkindex # ---------------------------------------------------------------------- @@ -134,9 +130,7 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} { # special parser and mess with its commands. if {[interp issafe]} { - proc auto_mkindex {dir args} { - error "can't generate index within safe interpreter" - } + return ;# Stop sourcing the file here } # auto_mkindex -- diff --git a/library/init.tcl b/library/init.tcl index 8e9d3f3..c069037 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.1.2.3 1998/11/11 04:08:24 stanton Exp $ +# RCS: @(#) $Id: init.tcl,v 1.1.2.4 1998/12/02 20:08:05 welch Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -95,7 +95,6 @@ if {(![interp issafe]) && ($tcl_platform(platform) == "windows")} { } } - # Setup the unknown package handler package unknown tclPkgUnknown diff --git a/library/ldAout.tcl b/library/ldAout.tcl index 788f5cf..f316e0e 100644 --- a/library/ldAout.tcl +++ b/library/ldAout.tcl @@ -18,7 +18,7 @@ # its .o file placed before all others in the command; then # "ld" is executed to bind the objects together. # -# RCS: @(#) $Id: ldAout.tcl,v 1.1.2.1 1998/09/24 23:59:06 stanton Exp $ +# RCS: @(#) $Id: ldAout.tcl,v 1.1.2.2 1998/12/02 20:08:06 welch Exp $ # # Copyright (c) 1995, by General Electric Company. All rights reserved. # @@ -98,9 +98,9 @@ proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} { } elseif {![string compare $a -o]} { set minusO 1 } - if [regexp {^-[lL]} $a] { + if {[regexp {^-[lL]} $a]} { lappend libraries $a - if [regexp {^-L} $a] { + if {[regexp {^-L} $a]} { lappend libdirs [string range $a 2 end] } } elseif {$seenDotO} { @@ -116,10 +116,10 @@ proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} { set libs {} foreach lib $libraries { - if [regexp {^-l} $lib] { + if {[regexp {^-l} $lib]} { set lname [string range $lib 2 end] foreach dir $libdirs { - if [file exists [file join $dir lib${lname}_G0.a]] { + if {[file exists [file join $dir lib${lname}_G0.a]]} { set lname ${lname}_G0 break } @@ -137,22 +137,22 @@ proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} { error "-o option must be supplied to link a Tcl load module" } set m [file tail $outputFile] - if [regexp {\.a$} $outputFile] { + if {[regexp {\.a$} $outputFile]} { set shlib_suffix .a } else { set shlib_suffix "" } - if [regexp {\..*$} $outputFile match] { - set l [expr [string length $m] - [string length $match]] + if {[regexp {\..*$} $outputFile match]} { + set l [expr {[string length $m] - [string length $match]}] } else { error "Output file does not appear to have a suffix" } - set modName [string tolower [string range $m 0 [expr $l-1]]] - if [regexp {^lib} $modName] { + set modName [string tolower [string range $m 0 [expr {$l-1}]]] + if {[regexp {^lib} $modName]} { set modName [string range $modName 3 end] } - if [regexp {[0-9\.]*(_g0)?$} $modName match] { - set modName [string range $modName 0 [expr [string length $modName]-[string length $match]-1]] + if {[regexp {[0-9\.]*(_g0)?$} $modName match]} { + set modName [string range $modName 0 [expr {[string length $modName]-[string length $match]-1}]] } set modName "[string toupper [string index $modName 0]][string range $modName 1 end]" @@ -160,7 +160,7 @@ proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} { set f [open $nmCommand r] while {[gets $f l] >= 0} { - if [regexp {T[ ]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol] { + if {[regexp {T[ ]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol]} { if {![regexp {_?([A-Z][a-z0-9_]*_(Safe)?Init)} $symbol trash s]} { set s $symbol } @@ -219,10 +219,10 @@ proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} { set ldCommand "ar cr $outputFile" regsub { -o} $tail {} tail } else { - set ldCommand ld - foreach item $head { - lappend ldCommand $item - } + set ldCommand ld + foreach item $head { + lappend ldCommand $item + } } lappend ldCommand tcl$modName.o foreach item $tail { diff --git a/library/package.tcl b/library/package.tcl index e44c0b2..437aa6a 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -3,7 +3,7 @@ # utility procs formerly in init.tcl which can be loaded on demand # for package management. # -# RCS: @(#) $Id: package.tcl,v 1.1.2.4 1998/11/11 04:08:25 stanton Exp $ +# RCS: @(#) $Id: package.tcl,v 1.1.2.5 1998/12/02 20:08:06 welch Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. @@ -27,20 +27,16 @@ # Results: # Returns 1 if the extension matches, 0 otherwise -if {$::tcl_platform(platform) == "windows"} { - proc pkg_compareExtension { fileName {ext {}} } { - if {[string compare $ext {}] == 0} { - set ext [info sharedlibextension] - } +proc pkg_compareExtension { fileName {ext {}} } { + global tcl_platform + if {[string length $ext] == 0} { + set ext [info sharedlibextension] + } + if {[string compare $tcl_platform(platform) "windows"] == 0} { return [expr {[string compare \ [string tolower [file extension $fileName]] \ [string tolower $ext]] == 0}] - } -} else { - proc pkg_compareExtension { fileName {ext {}} } { - if {[string compare $ext {}] == 0} { - set ext [info sharedlibextension] - } + } else { return [expr {[string compare [file extension $fileName] $ext] == 0}] } } @@ -61,6 +57,9 @@ if {$::tcl_platform(platform) == "windows"} { # -verbose (optional) Verbose output; the name of each file that # was successfully rocessed is printed out. Additionally, # if processing of a file failed a message is printed. +# -load pat (optional) Preload any packages whose names match +# the pattern. Used to handle DLLs that depend on +# other packages during their Init procedure. # dir - Name of the directory in which to create the index. # args - Any number of additional arguments, each giving # a glob pattern that matches the names of one or @@ -69,7 +68,7 @@ if {$::tcl_platform(platform) == "windows"} { proc pkg_mkIndex {args} { global errorCode errorInfo - set usage {"pkg_mkIndex ?-direct? ?-verbose? dir ?pattern ...?"}; + set usage {"pkg_mkIndex ?-direct? ?-verbose? ?-load pattern? ?--? dir ?pattern ...?"}; set argCount [llength $args] if {$argCount < 1} { @@ -79,6 +78,7 @@ proc pkg_mkIndex {args} { set more "" set direct 0 set doVerbose 0 + set loadPat "" for {set idx 0} {$idx < $argCount} {incr idx} { set flag [lindex $args $idx] switch -glob -- $flag { @@ -94,6 +94,11 @@ proc pkg_mkIndex {args} { set direct 1 append more " -direct" } + -load { + incr idx + set loadPat [lindex $args $idx] + append more " -load $loadPat" + } -* { return -code error "unknown flag $flag: should be\n$usage" } @@ -144,14 +149,27 @@ proc pkg_mkIndex {args} { cd $oldDir set c [interp create] - # Load into the child all packages currently loaded in the parent - # interpreter, in case the extension depends on some of them. + # Load into the child any packages currently loaded in the parent + # interpreter that match the -load pattern. foreach pkg [info loaded] { + if {! [string match $loadPat [lindex $pkg 1]]} { + continue + } if {[lindex $pkg 1] == "Tk"} { $c eval {set argv {-geometry +0+0}} } - load [lindex $pkg 0] [lindex $pkg 1] $c + if {[catch { + load [lindex $pkg 0] [lindex $pkg 1] $c + } err]} { + if {$doVerbose} { + tclLog "warning: load [lindex $pkg 0] [lindex $pkg 1]\nfailed with: $err" + } + } else { + if {$doVerbose} { + tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]" + } + } } cd $dir @@ -198,6 +216,15 @@ proc pkg_mkIndex {args} { $c eval [list set ::tcl::file $file] $c eval [list set ::tcl::direct $direct] + + # Download needed procedures into the slave because we've + # just deleted the unknown procedure. This doesn't handle + # procedures with default arguments. + + foreach p {pkg_compareExtension} { + $c eval [list proc $p [info args $p] [info body $p]] + } + if {[catch { $c eval { set ::tcl::debug "loading or sourcing" @@ -312,8 +339,8 @@ proc pkg_mkIndex {args} { if {$doVerbose} { tclLog "processed $file" } + interp delete $c } - interp delete $c } foreach pkg [lsort [array names files]] { @@ -444,5 +471,3 @@ proc tclPkgUnknown {name version {exact {}}} { } } } - - diff --git a/library/safe.tcl b/library/safe.tcl index 0ee3a92..76d4d29 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: safe.tcl,v 1.1.2.2 1998/09/24 23:59:07 stanton Exp $ +# RCS: @(#) $Id: safe.tcl,v 1.1.2.3 1998/12/02 20:08:06 welch Exp $ # # The implementation is based on namespaces. These naming conventions @@ -32,12 +32,6 @@ namespace eval ::safe { interpAddToAccessPath interpFindInAccessPath \ setLogCmd ; -# Proto/dummy declarations for auto_mkIndex -proc ::safe::interpCreate {} {} -proc ::safe::interpInit {} {} -proc ::safe::interpConfigure {} {} - - #### # # Setup the arguments parsing diff --git a/library/tclIndex b/library/tclIndex index 33701bf..35c7cf6 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -6,6 +6,18 @@ # element name is the name of a command and the value is # a script that loads the command. +set auto_index(auto_reset) [list source [file join $dir auto.tcl]] +set auto_index(tcl_findLibrary) [list source [file join $dir auto.tcl]] +set auto_index(auto_mkindex) [list source [file join $dir auto.tcl]] +set auto_index(auto_mkindex_old) [list source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::init) [list source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::cleanup) [list source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::mkindex) [list source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::hook) [list source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::slavehook) [list source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::command) [list source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::commandInit) [list source [file join $dir auto.tcl]] +set auto_index(::auto_mkindex_parser::fullname) [list source [file join $dir auto.tcl]] set auto_index(history) [list source [file join $dir history.tcl]] set auto_index(::tcl::HistAdd) [list source [file join $dir history.tcl]] set auto_index(::tcl::HistKeep) [list source [file join $dir history.tcl]] @@ -15,16 +27,13 @@ set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]] set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]] set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]] set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]] -set auto_index(unknown) [list source [file join $dir init.tcl]] -set auto_index(auto_load) [list source [file join $dir init.tcl]] -set auto_index(auto_load_index) [list source [file join $dir init.tcl]] -set auto_index(auto_qualify) [list source [file join $dir init.tcl]] -set auto_index(auto_import) [list source [file join $dir init.tcl]] set auto_index(tclLdAout) [list source [file join $dir ldAout.tcl]] +set auto_index(pkg_compareExtension) [list source [file join $dir package.tcl]] +set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]] +set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]] +set auto_index(tclMacPkgSearch) [list source [file join $dir package.tcl]] +set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]] set auto_index(parray) [list source [file join $dir parray.tcl]] -set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]] -set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]] set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]] set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]] set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]] @@ -70,19 +79,3 @@ set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]] set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]] set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]] set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]] -set auto_index(auto_reset) [list source [file join $dir auto.tcl]] -set auto_index(tcl_findLibrary) [list source [file join $dir auto.tcl]] -set auto_index(auto_mkindex) [list source [file join $dir auto.tcl]] -set auto_index(auto_mkindex_old) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::init) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::cleanup) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::mkindex) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::hook) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::slavehook) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::command) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::commandInit) [list source [file join $dir auto.tcl]] -set auto_index(::auto_mkindex_parser::fullname) [list source [file join $dir auto.tcl]] -set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]] -set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]] -set auto_index(tclMacPkgSearch) [list source [file join $dir package.tcl]] -set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]] |