#$Id: package.xotcl,v 1.1.1.1 2004/05/23 22:50:39 neumann Exp $
package provide xotcl::package 0.91

package require xotcl::mixinStrategy

rename package tcl_package

@ @File {description {
  Represent Tcl package loading command by an XOTcl
  object. Enables tracking, tracing, and verbose output
  of package loading
  }
}
@ Object package {
  description {
    Supports all Tcl package options plus present and verbose.
  }
}
@ package proc present {args "packageName or -exact packageName"} {
  description {
    Check whether a package is present or not. Similar to Tcl's 
    package present, but works with Tcl < 8.3
  }
}
@ package proc verbose {v  "1 or 0"} {
  description {
    Toggle verbose output on/off. If on, package prints the locations
    from where packages are loaded to the screen. Default is off.
  }
} 

Object package
package set component .
package set verbose 0
package proc unknown args {
  #puts stderr "unknown: package $args"
  eval tcl_package $args
}
package proc verbose value {
  my set verbose $value
}
package proc present args {
  if {$::tcl_version<8.3} {
    my instvar loaded
    switch -exact -- [lindex $args 0] {
      -exact  {set pkg [lindex $args 1]}
      default {set pkg [lindex $args 0]}
    }
    if {[info exists loaded($pkg)]} {
      return $loaded($pkg)
    } else {
      error "not found"
    }
  } else {
    eval tcl_package present $args
  }
}

package proc require args {
  my instvar component verbose uses loaded
  set prevComponent $component
  if {[catch {set v [eval package present $args]} msg]} {
    #puts stderr "we have to load $msg"
    switch -exact -- [lindex $args 0] {
	-exact  {set pkg [lindex $args 1]}
	default {set pkg [lindex $args 0]}
    }
    set component $pkg
    lappend uses($prevComponent) $component
    set v [eval tcl_package require $args]
    if {$v != "" && $verbose} {
      set path [lindex [tcl_package ifneeded $pkg $v] 1]
      puts "... $pkg $v loaded from ´$path´"
      set loaded($pkg) $v   ;# loaded stuff needed for Tcl 8.0
    }
  }
  set component $prevComponent
  return $v
}

Object package::tracker
package::tracker set verbose 0
package::tracker proc storeEntry {table index} {
    my instvar verbose $table
    set ${table}($index) "[package set component] [info script]"
    if {$verbose} {
	puts  "... $table $index loaded from [info script]"
    }
}
package::tracker proc dump {} {
  my instvar class object instproc proc
  if {[info exist class]}    { parray class }
  if {[info exist object]}   { parray object }
  if {[info exist instproc]} { parray instproc }
  if {[info exist proc]}     { parray proc }
}
package::tracker proc start {} {
    ::Class  add mixin [self]::M
    ::Object add mixin [self]::M
}

Class package::tracker::M
package::tracker::M instproc create {cls args} {
    set table [string tolower [string trimleft [self] :]]
    package::tracker storeEntry $table [lindex $args 0]
    next
    $cls add mixin [self class]
}
package::tracker::M instproc instproc args {
    package::tracker storeEntry instproc [self]->[lindex $args 0]
    next
}
package::tracker::M instproc proc args {
    package::tracker storeEntry proc [self]->[lindex $args 0]
    next
}

#package::tracker set verbose 1
#package::tracker start
#
#Class A
#A instproc p args {
#    puts A
#}
#A proc pp args {
#    a call 
#}
#Object o
#o proc ppp args {
#    another call
#}
#puts stderr ====================================================
#package::tracker dump

#puts stderr AUTO_PATH=$auto_path.