[PD-cvs] pd/src objective.tcl,1.1.2.23,1.1.2.24

[Mathieu Bouchard]

Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26038

Modified Files:
      Tag: devel_0_39
	objective.tcl 
Log Message:
forgot to commit error_text, which is needed by the new bgerror.tcl


Index: objective.tcl
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/objective.tcl,v
retrieving revision 1.1.2.23
retrieving revision 1.1.2.24
diff -C2 -d -r1.1.2.23 -r1.1.2.24
*** objective.tcl	6 Sep 2006 23:50:21 -0000	1.1.2.23
--- objective.tcl	18 Sep 2006 01:29:34 -0000	1.1.2.24
***************
*** 133,137 ****
  def Thing inspect {} {
  	set t [list "#<$self: "]
! 	foreach k [lsort [$self _vars]] {lappend t "$k=[list $@$k] "}
  	lappend t ">"
  	return [join $t ""]
--- 133,137 ----
  def Thing inspect {} {
  	set t [list "#<$self: "]
! 	foreach k [lsort [$self vars]] {lappend t "$k=[list $@$k] "}
  	lappend t ">"
  	return [join $t ""]
***************
*** 141,149 ****
  
  class_new Class
  def Class subclasses {} {return $@subclasses}
- def Class <= {class} {
- 	return [expr [lsearch [$self ancestors] $class]>=0]
- }
  
  def Class ancestors {} {
  	#if {[info exists @ancestors]} {}
--- 141,150 ----
  
  class_new Class
+ 
+ # those return only the direct neighbours in the hierarchy
+ def Class superclasses {} {return $@_super}
  def Class subclasses {} {return $@subclasses}
  
+ # those look recursively.
  def Class ancestors {} {
  	#if {[info exists @ancestors]} {}
***************
*** 152,155 ****
--- 153,157 ----
  	return $r
  }
+ def Class <= {class} {return [expr [lsearch [$self ancestors] $class]>=0]}
  
  # those are static methods, and objective.tcl doesn't distinguish them yet.
***************
*** 164,175 ****
  proc VTgrey   {} {return "\x1b\[0m"}
  
  proc error_dump {} {
! 	global errorCode errorInfo
! 	regsub -all "    invoked from within\n" $errorInfo "" errorInfo
! 	regsub -all "\n    \\(" $errorInfo " (" errorInfo
! 	regsub -all {\n[^\n]*procedure \"(::unknown|super)\"[^\n]*\n} $errorInfo "\n" errorInfo
! 	regsub -all {\s*while executing\s*\n} $errorInfo "\n" errorInfo
! 	#regsub {\n$} $errorInfo "" errorInfo
! 	puts "[VTred]Exception:[VTgrey] errorCode=$errorCode; errorInfo=$errorInfo"
  }
  
--- 166,182 ----
  proc VTgrey   {} {return "\x1b\[0m"}
  
+ proc error_text {} {
+ 	global errorInfo
+ 	set e $errorInfo
+ 	regsub -all "    invoked from within\n" $e "" e
+ 	regsub -all "\n    \\(" $e " (" e
+ 	regsub -all {\n[^\n]*procedure \"(::unknown|super)\"[^\n]*\n} $e "\n" e
+ 	regsub -all {\s*while executing\s*\n} $e "\n" e
+ 	#regsub {\n$} $e "" e
+ 	return $e
+ }
  proc error_dump {} {
! 	global errorCode
! 	puts "[VTred]Exception:[VTgrey] errorCode=$errorCode; errorInfo=[error_text]"
  }