Skip to content


Subversion checkout URL

You can clone with
Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

80 lines (62 sloc) 2.149 kb
# tcllauncher.tcl - tcl code that tcllauncher uses to do its thing
package require Tclx
# this is the code that gets called when Tcl launches because the
# tcllauncher "version" of Tcl jimmies the command line to make it
# so.
# this routine must now figure out what to do to launch the app
proc main {{argv ""}} {
set prog [info nameofexecutable]
# have we been invoked as a shell? If so, prog is empty, get it from
# the SHELL environment variable
if {$prog == ""} {
set prog $::env(SHELL)
set path [file split $prog]
set shortName [lindex $path end]
# tcllauncher cannot be invoked directly as "tcllauncher" -- it must be
# aliased to some other name
if {$shortName == "tcllauncher"} {
puts stderr "tcllauncher cannot be invoked as \"tcllauncher\"; it must be copied or linked as some other name"
exit 255
# if the last dir in the chain is "bin", swap in "lib/tcllauncher" in
# its place and tag a ".tcl" onto the end of the path name.
# otherwise just look in the same directory where the instance of the
# tcllauncher was found.
#puts stderr "path '$path', prog '$prog', shortName '$shortName'"
if {[lindex $path end-1] == "bin"} {
# this version looks for ../lib/tcllauncher/$shortName.tcl`
#set path [eval file join [lreplace $path end-1 end-1 lib tcllauncher]]
# this version looks for ../lib/$shortName/main.tcl
set ::launchdir [eval file join [lreplace $path end-1 end lib $shortName]]
set path [eval file join $::launchdir main.tcl]
} else {
set path $prog.tcl
if {![file readable $path]} {
puts stderr "$shortName: can't read '$path' (tcllauncher)"
exit 254
set ::argv0 $shortName
set initialArgv $argv
# ok now source in the file we (tcllauncher) figured out is the one
if {[catch {uplevel #0 source $path} catchResult] == 1} {
append ::errorInfo "\n from tcllauncher running \"[string trim "$::argv0 $initialArgv"]\""
puts stderr $::errorInfo
exit 255
exit 0
if {!$tcl_interactive} {
main $argv
Jump to Line
Something went wrong with that request. Please try again.