1# loadtable.tcl 2# 3# Ensures that the table library extension is loaded 4 5if {[string equal "Windows CE" $::tcl_platform(os)]} { 6 if {[info proc puts] != "puts" || ![llength [info command ::tcl::puts]]} { 7 # Rename puts to something innocuous on Windows CE, 8 # but only if it wasn't already renamed (thus it's a proc) 9 rename puts ::tcl::puts 10 proc puts args { 11 set la [llength $args] 12 if {$la<1 || $la>3} { 13 error "usage: puts ?-nonewline? ?channel? string" 14 } 15 set nl \n 16 if {[lindex $args 0]=="-nonewline"} { 17 set nl "" 18 set args [lrange $args 1 end] 19 } 20 if {[llength $args]==1} { 21 set args [list stdout [join $args]] ;# (2) 22 } 23 foreach {channel s} $args break 24 if {$channel=="stdout" || $channel=="stderr"} { 25 #$::putsw insert end $s$nl 26 } else { 27 set cmd ::tcl::puts 28 if {$nl==""} {lappend cmd -nonewline} 29 lappend cmd $channel $s 30 uplevel 1 $cmd 31 } 32 } 33 } 34} 35 36set ::VERSION 2.10 37if {[string compare unix $tcl_platform(platform)]} { 38 set table(library) Tktable$::VERSION[info sharedlibextension] 39} else { 40 set table(library) libTktable$::VERSION[info sharedlibextension] 41} 42if { 43 [string match {} [info commands table]] 44 && [catch {package require Tktable $::VERSION} err] 45 && [catch {load [file join [pwd] $table(library)]} err] 46 && [catch {load [file join [pwd] .. unix $table(library)]} err] 47 && [catch {load [file join [pwd] .. win $table(library)]} err] 48} { 49 error $err 50} else { 51 puts "Tktable v[package provide Tktable] loaded" 52} 53