Tcl Source Code

Artifact [c337a48cb5]
Login

Artifact c337a48cb5e2fe86234b565cd5eeda41309191a1:

Attachment "seg.tcl" to ticket [1001997fff] added by dgp 2004-08-02 21:06:32.
proc foo {} {
    set c [interp create]
    $c eval {
	proc ::tcl::GetAllNamespaces {} {return ::}
	namespace eval ::tcl {
	variable dir
	variable file
	variable direct
	variable x
	variable debug
	variable type		
	variable namespaces
	variable packages
	variable origCmds	
	variable newCmds
	variable newPkgs {}
	}
	set ::tcl::file a.tcl
	set ::tcl::debug "loading or sourcing"
	foreach ::tcl::x :: {
	    set ::tcl::namespaces($::tcl::x) 1
	}
	foreach ::tcl::x [package names] {
	    if {[string compare [package provide $::tcl::x] ""]} {
		set ::tcl::packages($::tcl::x) 1
	    }
	}
	set ::tcl::origCmds [info commands]
	set ::tcl::debug sourcing
	set ::tcl::type source
	foreach ::tcl::x [package names] {
	    if {[string compare [package provide $::tcl::x] ""] && ![info exists ::tcl::packages($::tcl::x)]} {
		lappend ::tcl::newPkgs [list $::tcl::x [package provide $::tcl::x]]
	    }
	}
    }
    interp delete $c
}
foo