Index: xotcl/library/lib/trace.xotcl
===================================================================
diff -u -r0896d4deb00780e48b5b03269bf9c4ecca948919 -r435b41481fb51bf000ebe736d8574fefbeec1710
--- xotcl/library/lib/trace.xotcl	(.../trace.xotcl)	(revision 0896d4deb00780e48b5b03269bf9c4ecca948919)
+++ xotcl/library/lib/trace.xotcl	(.../trace.xotcl)	(revision 435b41481fb51bf000ebe736d8574fefbeec1710)
@@ -1,265 +1,275 @@
-# -*- Tcl -*- $Id: trace.xotcl,v 1.3 2005/01/06 03:10:05 neumann Exp $
+# -*- Tcl -*- $Id: trace.xotcl,v 1.4 2005/09/09 21:07:23 neumann Exp $
 package provide xotcl::trace 0.91
-@ @File {description {
-  Various tracing tools for the XOTcl language.
-  }
-}
-@ Object instproc traceFilter {
-  args "arbitrary args"
-} {
-    Description {
-      Filter to trace every method call on an object or class hierarchy.
-      Outputs a message befora and after each call of the traced object.
+package require XOTcl
+
+namespace eval ::xotcl::trace {
+    namespace import ::xotcl::*
+
+    @ @File {description {
+	Various tracing tools for the XOTcl language.
     }
-    return "empty string"
-}
-@ Object Trace { 
-  Description {
-    Write trace outputs and produce statistics. Variable traceStream
-    defines where to write trace output (default: stderr).
-  }
-}
-@ Trace proc puts {line "output line"} {
-  Description {
-    Define how traceFilter writes to the output stream. Default:
-    write to trace stream.
-  }
-}
-@ Trace proc openTraceFile {name "file name"} {
-  Description {
-    Redirect trace output to file.
-  }
-}
-@ Trace proc closeTraceFile {name "file name"} {
-  Description {
-    Close trace  file and redirect output to stderr.
-  }
-}
-@ Object instproc lintFilter {} {
-  Description {Experimental lint filter}
-}
-@ Object instproc statFilter {} {
-  Description {Experimental statistics filter}
-}
-@ Object instproc showVars {args "ist of variables"} {
-  Description {Show the values of the specified variables (or of all variables)
-    of an object on stderr.}
-}
-@ Object instproc showMsg {msg "optional output"} {
-  Description {Show a message msg with the form "[self] $cls->$method $msg" on stderr.}
-}
-@ Object instproc showClass {} { Description {Show classes and mixins of the object}}
-@ Object instproc showStack {maxDepth "max stack depth, default=100"} { 
-  Description {Show callstack up to the specified calldepth.}}
-@ Object instproc showCall {} { Description {Show the current call with the form "[self] $cls->$method $args" on stderr.}}
-@ Object instproc showTimeStart {"?handle?" "Handle object name, optional"} {Description {start a timer}}
-@ Object instproc showTimeEnd {"?handle?" "Handle object name, optional"} {Description {end a timer and show result}}
+    }
+    @ Object instproc traceFilter {
+	args "arbitrary args"
+    } {
+	Description {
+	    Filter to trace every method call on an object or class hierarchy.
+	    Outputs a message befora and after each call of the traced object.
+	}
+	return "empty string"
+    }
+    @ Object Trace { 
+	Description {
+	    Write trace outputs and produce statistics. Variable traceStream
+	    defines where to write trace output (default: stderr).
+	}
+    }
+    @ Trace proc puts {line "output line"} {
+	Description {
+	    Define how traceFilter writes to the output stream. Default:
+	    write to trace stream.
+	}
+    }
+    @ Trace proc openTraceFile {name "file name"} {
+	Description {
+	    Redirect trace output to file.
+	}
+    }
+    @ Trace proc closeTraceFile {name "file name"} {
+	Description {
+	    Close trace  file and redirect output to stderr.
+	}
+    }
+    @ Object instproc lintFilter {} {
+	Description {Experimental lint filter}
+    }
+    @ Object instproc statFilter {} {
+	Description {Experimental statistics filter}
+    }
+    @ Object instproc showVars {args "ist of variables"} {
+	Description {Show the values of the specified variables (or of all variables)
+	    of an object on stderr.}
+    }
+    @ Object instproc showMsg {msg "optional output"} {
+	Description {Show a message msg with the form "[self] $cls->$method $msg" on stderr.}
+    }
+    @ Object instproc showClass {} { Description {Show classes and mixins of the object}}
+    @ Object instproc showStack {maxDepth "max stack depth, default=100"} { 
+	Description {Show callstack up to the specified calldepth.}}
+    @ Object instproc showCall {} { Description {Show the current call with the form "[self] $cls->$method $args" on stderr.}}
+    @ Object instproc showTimeStart {"?handle?" "Handle object name, optional"} {Description {start a timer}}
+    @ Object instproc showTimeEnd {"?handle?" "Handle object name, optional"} {Description {end a timer and show result}}
 
-##########################################################################
+    ##########################################################################
 
-proc showCall {} { Trace deprecated-function showCall}
-proc showVars {} { Trace deprecated-function showVars}
-proc showObj {o {printObjectName 1}} { Trace deprecated-function showObj}
-proc showStack {{m 100}} { Trace deprecated-function showStack}
+    proc showCall {} { Trace deprecated-function showCall}
+    proc showVars {} { Trace deprecated-function showVars}
+    proc showObj {o {printObjectName 1}} { Trace deprecated-function showObj}
+    proc showStack {{m 100}} { Trace deprecated-function showStack}
 
 
-Object Trace
-Trace set traceStream stderr
-Trace proc openTraceFile name {
-  my set traceStream [open $name w]
-}
-Trace proc closeTraceFile {} {
-  close $Trace::traceStream
-  my set traceStream stderr
-}
-Trace proc puts line {
-  puts $Trace::traceStream $line
-}
-Trace proc add {type classname} {
-  $classname instfilter [concat [$classname info instfilter] ${type}Filter]
-}
+    Object Trace
+    Trace set traceStream stderr
+    Trace proc openTraceFile name {
+	my set traceStream [open $name w]
+    }
+    Trace proc closeTraceFile {} {
+	close $Trace::traceStream
+	my set traceStream stderr
+    }
+    Trace proc puts line {
+	puts $Trace::traceStream $line
+    }
+    Trace proc add {type classname} {
+	$classname instfilter [concat [$classname info instfilter] ${type}Filter]
+    }
 
-Trace proc statReset {} {
-  catch {my unset stat}
-}
-Trace proc statReportClass c {
-  if {[my exists stat($c)]} {
-    puts "\nClass $c: [my set stat($c)] references"
-    foreach method [$c info instprocs] {
-      set key $c->$method			       
-      if {[info exists stat($key)]} {
-	puts "\t$key: [my set stat($key)] references"
-      } else {
-	puts "\t$key: not used"
-      }
+    Trace proc statReset {} {
+	catch {my unset stat}
     }
-  } else {
-    puts "\nClass $c: not used"
-  }
-  foreach subclass [lsort [$c info subclass]] {
-    my [self proc] $subclass
-  }
-}
-Trace proc statReport {} {
-  my statReportClass Object
-}
-Trace proc statCount key {
-  if {[my exists stat($key)]} {
-    my incr stat($key)
-  } else {
-    my incr set stat($key) 1
-  }
-}
-Trace proc deprecated-function {name} {
-  puts stderr "Function <$name> is deprecated. Use method with same name instead."
-}
+    Trace proc statReportClass c {
+	if {[my exists stat($c)]} {
+	    puts "\nClass $c: [my set stat($c)] references"
+	    foreach method [$c info instprocs] {
+						set key $c->$method			       
+						if {[info exists stat($key)]} {
+						    puts "\t$key: [my set stat($key)] references"
+						} else {
+						    puts "\t$key: not used"
+						}
+					    }
+	} else {
+	    puts "\nClass $c: not used"
+	}
+	foreach subclass [lsort [$c info subclass]] {
+	    my [self proc] $subclass
+	}
+    }
+    Trace proc statReport {} {
+	my statReportClass Object
+    }
+    Trace proc statCount key {
+	if {[my exists stat($key)]} {
+	    my incr stat($key)
+	} else {
+	    my incr set stat($key) 1
+	}
+    }
+    Trace proc deprecated-function {name} {
+	puts stderr "Function <$name> is deprecated. Use method with same name instead."
+    }
 
 
 
-Object instproc traceFilter args {
-  # don't trace the Trace object
-  if {[self] == "::Trace"} {return [next]}
-  set context "[self callingclass]->[self callingproc]"
-  set method [self calledproc]
-  switch -- $method {
-    proc -
-    instproc {set dargs [list [lindex $args 0] [lindex $args 1] ...] }
-    default  {set dargs $args }
-  }
-  #my showStack
-  Trace::puts "CALL $context>  [self]->$method $dargs (next=[self next])"
-  set result [next]
-  Trace::puts "EXIT $context>  [self]->$method ($result)"
-  return $result
-}
+    Object instproc traceFilter args {
+	# don't trace the Trace object
+	if {[self] == "::Trace"} {return [next]}
+	set context "[self callingclass]->[self callingproc]"
+	set method [self calledproc]
+	switch -- $method {
+	    proc -
+	    instproc {set dargs [list [lindex $args 0] [lindex $args 1] ...] }
+	    default  {set dargs $args }
+	}
+	#my showStack
+	Trace::puts "CALL $context>  [self]->$method $dargs (next=[self next])"
+	set result [next]
+	Trace::puts "EXIT $context>  [self]->$method ($result)"
+	return $result
+    }
 
-Object instproc lintFilter args {
-  #puts stderr c=[self class],ic[my info class],p=[self calledproc]
-  #puts stderr " =====================METHOD='[self calledproc]'"
-  my instvar __reported
-  switch -exact -- [self calledproc] {
-    instvar {
-      set ccls [self callingclass]
-      set method [self callingproc]
+    Object instproc lintFilter args {
+	#puts stderr c=[self class],ic[my info class],p=[self calledproc]
+	#puts stderr " =====================METHOD='[self calledproc]'"
+	my instvar __reported
+	switch -exact -- [self calledproc] {
+	    instvar {
+		set ccls [self callingclass]
+		set method [self callingproc]
 
-      #puts stderr ccls=$ccls.
-      if {$ccls == ""} { ;## instvar in proc
-	set bod [my info body $method]
-	set context "proc [self]->$method"
-      } else { ;## instvar in instproc
-	set bod [$ccls info instbody $method]
-	set context "instproc $ccls->$method"
-      }
-      foreach v $args {
-	set vpattern "$v\[^a-zA-Z0-9\]"
-	if {[regexp "\[\$\]$vpattern" $bod]} continue
-	if {[regexp " *$vpattern" $bod]}  continue
-	#if {[regexp "info *exists *$vpattern" $bod]}  continue
-	#if {[regexp "append *$vpattern" $bod]}  continue
-	#if {[regexp "array.*$vpattern" $bod]}  continue
-	if {[info exists __reported($v,$context)]} continue
-	set __reported($v,$context) 1
-	puts stderr "'$v' of 'instvar $args' is NOT used in\n\
+		#puts stderr ccls=$ccls.
+		if {$ccls == ""} { ;## instvar in proc
+		    set bod [my info body $method]
+		    set context "proc [self]->$method"
+		} else { ;## instvar in instproc
+		    set bod [$ccls info instbody $method]
+		    set context "instproc $ccls->$method"
+		}
+		foreach v $args {
+		    set vpattern "$v\[^a-zA-Z0-9\]"
+		    if {[regexp "\[\$\]$vpattern" $bod]} continue
+		    if {[regexp " *$vpattern" $bod]}  continue
+		    #if {[regexp "info *exists *$vpattern" $bod]}  continue
+		    #if {[regexp "append *$vpattern" $bod]}  continue
+		    #if {[regexp "array.*$vpattern" $bod]}  continue
+		    if {[info exists __reported($v,$context)]} continue
+		    set __reported($v,$context) 1
+		    puts stderr "'$v' of 'instvar $args' is NOT used in\n\
 	$context ... {$bod}"
-      }
+		}
+	    }
+	}
+	next
     }
-  }
-  next
-}
-Object instproc statFilter args {
-  # don't return statistics from the Trace object
-  #puts stderr "self=[self]"
-  if {[self] == "::Trace"} {return [next]}
-  set ccls [self callingclass]
-  set cmet [self callingproc]
-  set met [self calledproc]
-  #::puts stderr "cls=$ccls->$cmet, [self]->$met"
-  Trace statCount $ccls
-  Trace statCount $ccls->$cmet
-  next
-}
+    Object instproc statFilter args {
+	# don't return statistics from the Trace object
+	#puts stderr "self=[self]"
+	if {[self] == "::Trace"} {return [next]}
+	set ccls [self callingclass]
+	set cmet [self callingproc]
+	set met [self calledproc]
+	#::puts stderr "cls=$ccls->$cmet, [self]->$met"
+	Trace statCount $ccls
+	Trace statCount $ccls->$cmet
+	next
+    }
 
 
 
-######################################################################
-# show**** methods
-#
-Object instproc showVars args {
-  set msg {}
-  if {$args == {}} {
-    foreach var [lsort [my info vars]] {
-      if {[my array exists $var]} {
-	append msg "\n\t$var: "
-	#puts stderr "ARRAY $var"
-	#puts stderr "ARRAY names <[[self]array names $var]>"
-	foreach i [lsort [my array names $var]] {
-	  append msg $i=[my set ${var}($i)] ", "
+    ######################################################################
+    # show**** methods
+    #
+    Object instproc showVars args {
+	set msg {}
+	if {$args == {}} {
+	    foreach var [lsort [my info vars]] {
+		if {[my array exists $var]} {
+		    append msg "\n\t$var: "
+		    #puts stderr "ARRAY $var"
+		    #puts stderr "ARRAY names <[[self]array names $var]>"
+		    foreach i [lsort [my array names $var]] {
+			append msg $i=[my set ${var}($i)] ", "
+		    }
+		} elseif {[my exists $var]} {
+		    append msg "\n\t$var: " [list [my set $var]]
+		} else {
+		    append msg "\n\t$var: " UNKNOWN
+		}
+	    }
+	} else {
+	    foreach var $args {
+		if {[my array exists $var]} {
+		    lappend msg $var: ARRAY
+		} elseif {[my exists $var]} {
+		    lappend msg $var: [my set $var]
+		} else {
+		    lappend msg $var: UNKNOWN
+		}
+	    }
 	}
-      } elseif {[my exists $var]} {
-	append msg "\n\t$var: " [list [my set $var]]
-      } else {
-	append msg "\n\t$var: " UNKNOWN
-      }
+	set method [self callingproc]
+	set cls [self callingclass]
+	puts stderr "[self] $cls->$method $msg"
+	#puts stderr "        MIXINS: [my info mixin]"
     }
-  } else {
-    foreach var $args {
-      if {[my array exists $var]} {
-	lappend msg $var: ARRAY
-      } elseif {[my exists $var]} {
-	lappend msg $var: [my set $var]
-      } else {
-	lappend msg $var: UNKNOWN
-      }
+    Object instproc showMsg msg {
+	set method [self callingproc]
+	set cls [self callingclass]
+	puts stderr "[self] $cls->$method $msg"
     }
-  }
-  set method [self callingproc]
-  set cls [self callingclass]
-  puts stderr "[self] $cls->$method $msg"
-  #puts stderr "        MIXINS: [my info mixin]"
-}
-Object instproc showMsg msg {
-  set method [self callingproc]
-  set cls [self callingclass]
-  puts stderr "[self] $cls->$method $msg"
-}
-Object instproc showClass {} {
-  set method [self callingproc]
-  set cls [self callingclass]
-  puts stderr "[self] $cls->$method class [my info class]\
+    Object instproc showClass {} {
+	set method [self callingproc]
+	set cls [self callingclass]
+	puts stderr "[self] $cls->$method class [my info class]\
 	mixins {[my info mixin]}"
-}
-Object instproc showStack {{m 100}} {
-  set max [info level]  
-  if {$m<$max} {set max $m}
-  puts stderr "Call Stack (level: command)"
-  for {set i 0} {$i < $max} {incr i} {
-    if {[catch {set s [uplevel $i self]} msg]} {
-      set s ""
     }
-    puts stderr "[format %5d -$i]:\t$s [info level [expr {-$i}]]"
-  }
-}
-Object instproc showCall {} {
-  set method [self callingproc]
-  set cls [self callingclass]
-  set args [lreplace [info level -1] 0 0]
-  puts stderr "[self] $cls->$method $args"
-}
-Object instproc showTimeStart {{handle __h}} {
-  upvar [self callinglevel] $handle obj
-  set obj [Object [self]::[my autoname __time]]
-  $obj set clicks [clock clicks]
-  return
-}
-Object instproc showTimeEnd {{handle __h}} {
-  upvar [self callinglevel] $handle obj
-  set method [self callingproc]
-  set cls [self callingclass]
-  set elapsed [expr {([clock clicks]-[$obj set clicks])/1000000.0}]
-  puts stderr "[self] $cls->$method: elapsed [format %.2f $elapsed]secs"
-  $obj destroy
-}
+    Object instproc showStack {{m 100}} {
+	set max [info level]  
+	if {$m<$max} {set max $m}
+	puts stderr "Call Stack (level: command)"
+	for {set i 0} {$i < $max} {incr i} {
+	    if {[catch {set s [uplevel $i self]} msg]} {
+		set s ""
+	    }
+	    puts stderr "[format %5d -$i]:\t$s [info level [expr {-$i}]]"
+	}
+    }
+    Object instproc showCall {} {
+	set method [self callingproc]
+	set cls [self callingclass]
+	set args [lreplace [info level -1] 0 0]
+	puts stderr "[self] $cls->$method $args"
+    }
+    Object instproc showTimeStart {{handle __h}} {
+	upvar [self callinglevel] $handle obj
+	set obj [Object [self]::[my autoname __time]]
+	$obj set clicks [clock clicks]
+	return
+    }
+    Object instproc showTimeEnd {{handle __h}} {
+	upvar [self callinglevel] $handle obj
+	set method [self callingproc]
+	set cls [self callingclass]
+	set elapsed [expr {([clock clicks]-[$obj set clicks])/1000000.0}]
+	puts stderr "[self] $cls->$method: elapsed [format %.2f $elapsed]secs"
+	$obj destroy
+    }
 
 
-######################################################################
+    ######################################################################
 
+
+    namespace export showCall showVars showObj showStack Trace
+}
+
+namespace import ::xotcl::trace::*