reorganized

svn path=/trunk/; revision=9400

1 files changed, 9019 insertions, 0 deletions

diff --git a/desiredata/src/desire.tk b/desiredata/src/desire.tk
new file mode 100644
index 00000000..70f3d052
--- /dev/null
+++ b/desiredata/src/desire.tk
@@ -0,0 +1,9019 @@
+#!/usr/bin/env wish
+set cvsid {$Id: desire.tk,v 1.1.2.600.2.419 2007-10-27 00:22:27 matju Exp $}
+#-----------------------------------------------------------------------------------#
+# 
+# DesireData
+#   Copyright (c) 2004 by Mathieu Bouchard
+#   Copyright (c) 2005,2006,2007 by Mathieu Bouchard and Chun Lee
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+
+# See file ../COPYING.desire-client.txt for further informations on licensing terms.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# Note that this is not under the same license as the rest of PureData.
+# Even the DesireData server-side modifications stay on the same license
+# as the rest of PureData.
+#
+#-----------------------------------------------------------------------------------#
+
+# this command rebuilds the package index: echo pkg_mkIndex . | tclsh
+
+set debug 0 ;# DON'T TOUCH THIS, make yourself a debug.tcl instead!
+
+if {[catch {winfo children .}]} {set tk 0} {set tk 1}
+
+set argh0 [file normalize [file join [pwd] $argv0]]
+set auto_path [concat . \
+	[list [file join [file dirname [file dirname $argh0]] lib/pd/bin]] \
+	/usr/lib/tcllib1.7 \
+	/usr/lib/tclx8.4 \
+	$auto_path]
+
+package require poe
+if {$tk} {package require bgerror}
+
+catch {package require Tclx}
+#if {[catch {source /home/matju/src/pd-desiredata/pd/src/profile_dd.tcl}]} {error_dump}
+if {[file exists debug.tcl]} {source debug.tcl}
+
+proc which {file} {
+	global env
+	foreach dir [split $::env(PATH) ":"] {
+		if {[file exists $dir/$file]} {return $dir/$file}
+	}
+	return ""
+}
+
+#-----------------------------------------------------------------------------------#
+# some list processing functions and some math too
+# these could become another library like objective.tcl
+# if they become substantial enough
+
+# min finds the smallest of two values
+# max finds the biggest of two values
+# [clip $v $min $max] does [max $min [min $max $v]]
+proc min {x y} {expr {$x<$y?$x:$y}}
+proc max {x y} {expr {$x>$y?$x:$y}}
+proc clip {x min max} {
+	if {$x<$min} {return $min}
+	if {$x>$max} {return $max}
+	return $x
+}
+
+# set several variables from elements of a list
+# WARNING: for @-variables, use [list @a @b @c] instead of {@a @b @c}
+proc mset {vars list} {
+	uplevel 1 "foreach {$vars} {$list} {break}"
+}
+
+# add or subtract two lists
+proc l+   {   al bl} {set r {}; foreach a $al b $bl {lappend r [expr {$a+$b}]}; return $r}
+proc l-   {   al bl} {set r {}; foreach a $al b $bl {lappend r [expr {$a-$b}]}; return $r}
+# halve a list
+proc l/2  {   al   } {set r {}; foreach a $al       {lappend r [expr {$a/2 }]}; return $r}
+
+# like l+ or l- but for any infix supported by expr
+proc lzip {op al bl} {
+	set r {}
+	set e "\$a $op \$b"
+	foreach a $al b $bl {lappend r [expr $e]}
+	return $r
+}
+
+# do an operation between all elements of a list and a second argument
+proc lmap {op al b } {
+	set r {}
+	set e "\$a $op \$b"
+	foreach a $al       {lappend r [expr $e]}
+	return $r
+}
+
+# sum and product of a list, like math's capital Sigma and capital Pi.
+proc lsum  {al} {set r 0; foreach a $al {set r [expr {$r+$a}]}; return $r}
+proc lprod {al} {set r 1; foreach a $al {set r [expr {$r*$a}]}; return $r}
+
+# all elements from end to beginning
+proc lreverse {list} {
+	set r {}
+	for {set i [expr {[llength $list]-1}]} {$i>=0} {incr i -1} {lappend r [lindex $list $i]}
+	return $r
+}
+
+# list substraction is like set substraction but order-preserving
+# this is the same algorithm as Ruby's - operation on Arrays
+proc lwithout {a b} {
+	set r {}
+	foreach x $b {set c($x) {}}
+	foreach x $a {if {![info exists c($x)]} {lappend r $x}}
+	return $r
+}
+
+proc lintersection {a b} {
+	set r {}
+	foreach x $b {set c($x) {}}
+	foreach x $a {if {[info exists c($x)]} {lappend r $x}}
+	return $r
+}
+
+# removes duplicates from a list, but it must be already sorted.
+proc luniq {a} {
+	set last [lindex $a 0]
+	set r [list $last]
+	set i 0
+	foreach x $a {
+		if {$i && [string compare $last $x]} {lappend r $x}
+		incr i; set last $x
+	}
+	return $r
+}
+
+# one-dimensional intervals (left-closed, right-open); not much in use at the moment, not that they wouldn't deserve to!
+proc inside      {x x0 x1} {return [expr $x>=$x0 && $x<$x1]}
+proc overlap {y0 y1 x0 x1} {return [expr [inside $y0 $x0 $x1] || [inside $y1 $x0 $x1]]}
+
+proc distance {point1 point2} {
+	set off [l- $point1 $point2]
+	return [expr {sqrt([lsum [lzip * $off $off]])}]
+}
+
+proc rect_centre {rect} {
+	mset {x1 y1 x2 y2} $rect
+	return [list [expr {($x1+$x2)/2}] [expr {($y1+$y2)/2}]]
+}
+
+proc lmake {start end} {for {set i $start} {$i<=$end} {incr i} {lappend l $i}; return $l}
+#-----------------------------------------------------------------------------------#
+set callback_list {}
+
+proc append_callback {mode when def} {
+	global callback_list
+	dict set callback_list $mode $when $def
+}
+
+proc remove_callback {mode} {
+	global callback_list
+	set callback_list [dict remove $callback_list $mode]
+}
+
+proc modes_callback {self def {args}} {
+	global callback_list
+	set i 0
+	dict for {mode callbacks} $callback_list {
+		foreach {when call} $callbacks {
+			if {$def == $when} {eval $self $call $args; incr i}
+		}
+	}
+	if {!$i} {return 0} else {return 1}
+}
+
+#-----------------------------------------------------------------------------------#
+# Observer pattern
+# there's no class for "observer".
+# it's anything that has def $myclass notice {args} {...} in which args indicate
+# attributes that have changed, or is an empty list if an unspecified number of
+# attributes (maybe all) have changed.
+
+class_new Observable {}
+def Observable init {args} {
+	eval [concat [list super] $args]
+	set @subscribers {}
+}
+def Observable subscribe {observer} {
+	set i [lsearch $@subscribers $observer]
+	if {$i<0} {lappend @subscribers $observer}
+}
+def Observable unsubscribe {observer} {
+	set i [lsearch $@subscribers $observer]
+	if {$i>=0} {set @subscribers [lreplace $@subscribers $i $i]}
+}
+
+if {$have_expand} {
+  #def Observable changed              {args} {
+  #  puts "Observable changed $self called from [info level [expr [info level]-2]]"
+  #  foreach x $@subscribers {$x notice   $self {expand}$args]}
+  #}
+  def Observable changed              {args} {foreach x $@subscribers {$x notice   $self {expand}$args}}
+  def Observable child_changed {origin args} {foreach x $@subscribers {$x notice $origin {expand}$args}}
+} else {
+  def Observable changed              {args} {foreach x $@subscribers {eval [concat [list $x notice   $self] $args]}}
+  def Observable child_changed {origin args} {foreach x $@subscribers {eval [concat [list $x notice $origin] $args]}}
+}
+def Observable subscribers {} {return $@subscribers}
+
+#-----------------------------------------------------------------------------------#
+set poolset(foo) bar
+array unset poolset foo
+
+class_new Manager {Thing}
+
+def Manager init {} {
+	set @q {}
+	$self call
+}
+
+def Manager call {} {
+	global poolset
+	#if {[llength $@q]} {post "client queue %d" [llength $@q]}
+
+	for {set i 0} {$i < [llength $@q]} {incr i} {
+		set o [lindex $@q $i]
+		unset poolset($o)
+		if {[info exists _($o:_class)]} {
+			if {[catch {$o draw_maybe}]} {puts [error_dump]}
+		} else {
+			puts "  tries to draw ZOMBIE $o"
+		}
+		if {$i == [expr [llength $@q] - 1]} {set @q {}}
+	}
+	after 50 "$self call"
+}
+
+def Manager notice {origin args} {
+	global poolset
+	if {[info exists poolset($origin)]} {
+		# post %s "def Manager notice: double dirty"
+		# nothing for now
+	} {
+		set poolset($origin) {-1}
+		lappend @q $origin
+	}
+	#post "Manager notice: queue length is now %d" [llength $@q]
+}
+
+set serial 0
+proc serial {n obj} {
+	if {$n >= $::serial} {error "object creation serial number is in the future"}
+	eval [concat $::replyset($n) [list $obj]]
+	array unset ::replyset $n
+}
+
+proc philtre {atoms} {
+	set r {}
+	foreach atom $atoms {lappend r [regsub -all {([;,\\ ])} $atom {\\\1}]}
+	return [join $r]
+}
+
+# you pass the 2nd argument if and only if the message creates an object (or pretends to).
+# this happens with #N canvas, and those methods of #X:
+#   obj, msg, floatatom, symbolatom, text, connect, text_setto, array.
+# this does NOT happen with #X coords/restore/pop.
+proc netsend {message {callback ""}} {
+	#if {$message == ""} {error "empty message... surely a mistake"}
+	if {$::sock == ""} {error "connection to server needed for doing this"}
+	if {$callback != ""} {
+		set ::replyset($::serial) $callback
+		set message [concat [lrange $message 0 0] [list with_reply $::serial] [lrange $message 1 end]]
+		incr ::serial
+	}
+	set text "[philtre $message];"
+	if {$::debug} {puts "[VTcyan]<- $text[VTgrey]"}
+	puts $::sock $text
+}
+
+#-----------------------------------------------------------------------------------#
+# This is not a real Hash, just the same interface as a Ruby/Python/Perl Hash... or quite like Tcl arrays themselves
+class_new Hash {Thing}
+
+def Hash   init {args} {      super; foreach {k v} $args {$self set $k $v}}
+def Hash reinit {args} {$self clear; foreach {k v} $args {$self set $k $v}}
+def Hash set {k v} {set ::hash($self:$k) $v}
+def Hash exists {k} {info exists ::hash($self:$k)}
+def Hash get {k}   {set ::hash($self:$k)}
+def Hash size {} {llength [$self keys]}
+def Hash unset {k} {unset ::hash($self:$k)}
+def Hash list {} {set r {}; foreach k [$self keys] {lappend r $k [$self get $k]}; return $r}
+def Hash keys {} {
+	set r {}
+	set n [string length $self:]
+	foreach k [array names ::hash $self:*] {lappend r [string range $k $n end]}
+	return $r
+}
+def Hash values {} {
+	set r {}
+	foreach k [array names ::hash $self:*] {lappend r $::hash($k)}
+	return $r
+}
+def Hash clear {} {foreach k [$self keys] {$self unset $k}}
+def Hash delete {} {$self clear; super}
+
+def Hash search {v} {
+	foreach k [$self keys] {if {[$self get $k] == $v} {return $k}}
+	return -1 ;# this is not correct as -1 could be a Hash key, though not in its current context of use...
+}
+
+if 0 {
+	set h [Hash new foo bar 1 2 3 4]
+	$h set hello world
+	puts keys=[$h keys]
+	puts values=[$h values]
+	puts list=[$h list]
+	$h unset foo
+	puts list=[$h list]
+	$h clear
+	puts list=[$h list]
+	foreach i {1 2 3 4} {puts "exists $i : [$h exists $i]"}
+}
+
+class_new Selection {Hash}
+def Selection set {k v} {super $k $v; $v selected?= 1}
+def Selection unset {k} {
+	#set v [$self get $k]; puts "$v ::: [$v class]"
+	if {[$self exists $k]} {[$self get $k] selected?= 0}
+	super $k
+}
+#-----------------------------------------------------------------------------------#
+# abstract class: subclass must def {value value= <<}
+class_new Clipboard {Observable Thing}
+def Clipboard init   {{value ""}} {super; $self value= $value; set @copy_count 0}
+
+# uses system clipboard
+class_new Clipboard1 {Clipboard}
+def Clipboard1 value= {value} {clipboard clear; clipboard append $value; $self changed}
+def Clipboard1 << {value}     {                 clipboard append $value; $self changed}
+def Clipboard1 value {} {clipboard get}
+
+# uses string buffer (not system clipboard)
+class_new Clipboard2 {Clipboard}
+def Clipboard2 value= {value} {set    @value $value; $self changed}
+def Clipboard2 << {value}     {append @value $value; $self changed}
+def Clipboard2 value {} {return $@value}
+
+if {$tk} {
+  set clipboard [Clipboard1 new]
+} else {
+  set clipboard [Clipboard2 new]
+}
+
+#-----------------------------------------------------------------------------------#
+class_new EventHistory {Observable Thing}
+
+def EventHistory init {} {super; set @list {}}
+def EventHistory add {e} {lappend @list $e; $self changed add $e}
+def EventHistory list {{formatted 1}} {
+	if {!$formatted} {return $@list}
+	set r {}
+	foreach event $@list {
+		mset {type W x y mod K k} $event
+		lappend r [format "%-13s %9s %4d %4d %4d %4d %s" $type $K $k $x $y $mod $W]
+	}
+	return $r
+}
+set ::event_history [EventHistory new]
+
+#-----------------------------------------------------------------------------------#
+class_new CommandHistory {Observable Thing}
+
+def CommandHistory init {} {
+	super
+	set @undo_stack {}
+	set @redo_stack {}
+}
+
+def CommandHistory can_undo? {} {return [expr [llength @undo_stack] > 0]}
+def CommandHistory can_redo? {} {return [expr [llength @redo_stack] > 0]}
+def CommandHistory next_undo_name {} {return stuff}
+def CommandHistory next_redo_name {} {return stuff}
+def CommandHistory undo_stack {} {return $@undo_stack}
+def CommandHistory redo_stack {} {return $@redo_stack}
+
+# overload this if you want to control how many levels
+# of undo may be kept.
+# keep in mind that undo information is kept hierarchically.
+def CommandHistory add {message} {
+	lappend @undo_stack [list do $message [lrange [info level -3] 1 end]]
+	set @redo_stack {}
+	$self changed
+}
+
+def CommandHistory can't {} {
+	lappend @undo_stack [list can't {} [lrange [info level -3] 1 end]]
+	set @redo_stack {}
+	$self changed
+}
+
+# runs the restore procedure for the last item in the root undo queue.
+def CommandHistory undo {} {
+	global errorInfo
+	if {![$self can_perform? [lindex $@undo_stack end]]} {error "Can't undo this!"}
+	set backup $@undo_stack
+	set @undo_stack $@redo_stack
+	set @redo_stack {}
+	#set err [catch {$self perform [lindex $backup end]}]; if {$err} {set err $errorInfo}
+	$self perform [lindex $backup end]
+	set @redo_stack $@undo_stack
+	set @undo_stack [lrange $backup 0 end-1]
+	$self changed
+	#if {$err} {post %s $err; error "undo: $err"}
+}
+
+def CommandHistory redo {} {
+	global errorInfo
+	if {![$self can_perform? [lindex $@undo_stack end]]} {error "Can't redo this!"}
+	set backup $@redo_stack
+	set @redo_stack {}
+	set err [catch {$self perform [lindex $backup end]}]; if {$err} {set err $errorInfo}
+	$self perform [lindex $backup end]
+	set @redo_stack [lrange $backup 0 end-1]
+	$self changed
+	#if {$err} {post %s $err; error "redo: $err"}
+}
+
+def CommandHistory can_perform? {action} {
+	switch -- [lindex $action 0] {
+	  do      {return 1}
+	  can't   {return 0}
+	  default {
+	    foreach x [lrange $action 1 end] {
+	      if {![$self can_perform? $x]} {return 0}
+	    }
+	    return 1
+	  }
+	}
+}
+
+def CommandHistory perform {action} {
+	switch -- [lindex $action 0] {
+	  do      {eval [lindex $action 1]}
+	  can't   {error "can't undo this!"}
+	  default {foreach x [lindex $action 1] {$self perform $x}}
+	}
+}
+
+def CommandHistory atomically {what code} {
+	global errorInfo
+	set ubackup @undo_stack; set @undo_stack {}
+	set rbackup @redo_stack; set @redo_stack {}
+	uplevel 2 $code
+	set atom $@undo_stack
+	set @undo_stack $ubackup
+	set @redo_stack $rbackup
+	lappend @undo_stack [list $what $atom [lrange [info level -3] 1 end]]
+	$self changed
+}
+
+def CommandHistory list {} {
+	set r {}
+	set hist [concat [$self undo_stack] [list "You Are Here"] [lreverse [$self redo_stack]]]
+	set i 0
+	foreach e $hist {lappend r "$i: $e"; incr i}
+	return $r
+}
+
+set command_history [CommandHistory new]
+
+#-----------------------------------------------------------------------------------#
+class_new History {Thing}
+
+def History init {size} {
+	set @size $size
+	set @hist {{}}
+	set @histi -1
+}
+
+def History histi= {val} {set @histi $val}
+def History histi {} {return $@histi}
+
+def History set_hist {idx stuff} {set @hist [lreplace $@hist $idx $idx $stuff]}
+
+def History prepend {stuff} {
+	set @hist [linsert $@hist 1 $stuff]
+	if {[llength $@hist] >= $@size} {set @hist [lrange $@hist 0 [expr $@size-1]]}
+}
+
+def History traverse {incr} {
+	set @histi [expr $@histi + $incr]
+	set mod [expr ([llength $@hist]<[expr $@size+1]) ?[llength $@hist]:[expr $@size+1]]
+	if {$@histi >=$mod} {set @histi [expr $@histi%$mod]}
+	if {$@histi < 0} {set @histi [expr ($@histi+$mod)%$mod]}
+	return [lindex $@hist $@histi]
+}
+
+History new_as obj_hist 5
+#-----------------------------------------------------------------------------------#
+# this is the beginning of the more application-dependent part.
+
+switch $tcl_platform(os) {
+  Darwin {set OS osx}
+  default {set OS $tcl_platform(platform)}
+}
+
+if {$tk} {
+	option add *foreground #000000
+	option add *font {Helvetica -12}
+	foreach tkclass {Menu Button Checkbutton Radiobutton Entry Text Spinbox Scrollbar Canvas} {
+		option add *$tkclass*borderWidth 1
+		option add *$tkclass*activeBorderWidth 1
+	}
+	foreach tkclass {CheckButton RadioButton} {
+		option add *$tkclass*selectColor #dd3000
+	}
+	foreach tkclass {Entry Text} {
+		option add *$tkclass*background #b0c4d8
+		option add *$tkclass*selectBackground #6088b0
+	}
+	option add *__tk__messagebox*Canvas*borderWidth 0
+	foreach tkclass {Listbox} {
+		option add *$tkclass*background #c4d8b0
+		option add *$tkclass*selectBackground #88b060
+	}
+	foreach tkclass {Label} {
+		#option add *$tkclass*background #909090
+	}
+	# very small icons:
+	foreach {name w h values} {
+		icon_empty      7 7 "0,0,0,0,0,0,0"
+		icon_plus       7 7 "8,8,8,127,8,8,8"
+		icon_minus      7 7 "0,0,0,127,0,0,0"
+		icon_close      7 7 "99,119,62,28,62,119,99"
+		icon_wedge_up   7 5 "8,28,62,127,0"
+		icon_wedge_down 7 5 "0,127,62,28,8"
+		icon_up         7 7 "8,28,62,127,28,28,28"
+		icon_down       7 7 "28,28,28,127,62,28,8"
+		icon_right      7 7 "8,24,63,127,63,24,8"
+		icon_left       7 7 "8,12,126,127,126,12,8"
+	} {
+		image create bitmap $name -data "#define z_width $w\n#define z_height $h
+			static unsigned char z_bits[] = { $values };"
+	}
+	# it's unfortunate but we seem to have to turn off global bindings
+	# for Text objects to get control-s and control-t to do what we want for
+	# "text" dialogs below. Also we have to get rid of tab's changing the focus.
+	bind all <Key-Tab> ""
+	#bind all <Key-Shift-Tab> ""
+	bind all <<PrevWindow>> ""
+	bind Text <Control-t> {}
+	bind Text <Control-s> {}
+	set mods {{} 0 Shift- 1 Control- 4 Shift-Control- 5 Alt- 8 Shift-Alt- 9 Control-Alt- 12 Shift-Control-Alt- 13}
+	foreach type {KeyPress KeyRelease} {
+	    foreach {subtype mod} $mods {
+		bind all <$subtype$type> "$::event_history add \[list $type %W %x %y $mod %K %k\]"
+	    }
+	}
+	foreach type {ButtonPress ButtonRelease} {
+	    foreach {subtype mod} $mods {
+		bind all <$subtype$type> "$::event_history add \[list $type %W %x %y $mod %b %b\]"
+	    }
+	}
+}
+
+proc modekey {k mode} {
+  set s ""
+  if {$mode&1} {append s Shift-}
+  if {$mode&4} {append s Control-}
+  if {$mode&8} {append s Alt-}
+	if {[regexp {[0-9]} $k]} {set k Key-$k}
+  return $s$k
+}
+
+proc modeclick {k mode event} {
+  set s ""
+  if {$mode&1} {append s Shift-}
+  if {$mode&4} {append s Control-}
+  if {$mode&8} {append s Alt-}
+	if {[regexp {[0-9]} $k]} {set k $event-$k}
+  return $s$k
+}
+
+
+# there are two palettes of 30 colours used in Pd
+# when placed in a 3*10 grid, the difference is that
+# the left corner of 3*3 (the greys) are transposed (matrixwise)
+# here is the one used in the swatch color selector:
+set preset_colors {
+	fcfcfc e0e0e0 bcbcbc fce0e0 fce0c0 fcfcc8 d8fcd8 d8fcfc dce4fc f8d8fc
+	a0a0a0 7c7c7c 606060 fc2828 fcac44 e8e828 14e814 28f4f4 3c50fc f430f0
+	404040 202020 000000 8c0808 583000 782814 285014 004450 001488 580050
+}
+
+set preset_colors2 {
+	fcfcfc a0a0a0 404040 fce0e0 fce0c0 fcfcc8 d8fcd8 d8fcfc dce4fc f8d8fc
+	e0e0e0 7c7c7c 202020 fc2828 fcac44 e8e828 14e814 28f4f4 3c50fc f430f0
+	bcbcbc 606060 000000 8c0808 583000 782814 285014 004450 001488 580050
+}
+
+switch $::OS {
+  osx     {set pd_tearoff 0}
+  default {set pd_tearoff 1}
+}
+
+proc guess_lang {} {
+  set lang C
+  if {[info exist ::env(LC_ALL)]} {set lang $::env(LC_ALL)}
+  if {[info exist ::env(LANG)]}   {set lang $::env(LANG)}
+  set lang [lindex [split $lang {[_.]}] 0]
+  return $lang
+}
+
+#temporary
+set leet 0
+
+proc say {k args} {
+  global text
+  if {[llength $args]} {
+    set text($k) [lindex $args 0]
+  } else {
+    if {[info exist text($k)]} {
+        if {$::leet} {
+		return [string map -nocase {a 4 e 3 t 7 s 5 i 1 o 0 g 9} $text($k)]
+	} else {
+		return $text($k)
+	}
+    } else {return "{{$k}}"}
+  }
+}
+
+proc can_say {k args} {
+  return [info exist ::text($k)]
+}
+
+proc say_namespace {k code} {uplevel 1 $code}
+proc say_category  {text} {}
+
+switch -- [lindex [file split $argh0] end] {
+  desire.tk {set cmdline(server) [file join [file dirname $argh0] pd]}
+  default {set cmdline(server) [file join [file dirname [file dirname $argh0]] bin/pd]}
+}
+
+set cmdline(rcfilename) ~/.pdrc
+set cmdline(ddrcfilename) ~/.ddrc
+set cmdline(console) 1000
+if {[file exists ../icons/mode_edit.gif]} {
+	set cmdline(icons) ../icons
+} else {
+	set cmdline(icons) [file join [file dirname [file dirname $argh0]] lib/pd/icons]
+}
+
+#-----------------------------------------------------------------------------------#
+set accels {}
+proc read_client_prefs_from {filename} {
+	global cmdline look key accels
+	set ::accels {}
+	puts "reading from $filename"
+	set fd [open $filename]
+	set contents [read $fd]
+	close $fd
+	foreach {category category_data} $contents {
+		foreach {class class_data} $category_data {
+			foreach {var val} $class_data {set ${category}($class:$var) $val}
+		}
+	}
+	foreach k [array names key] {
+	    if {[llength $key($k)]} {
+		if {![dict exists $accels $key($k)]} {
+			dict set accels $key($k) $k
+		} else {
+			dict lappend accels $key($k) $k
+		}
+	    }
+	}
+}
+proc read_ddrc {} { ;# load defaults then load .ddrc
+	if {[file exists "defaults.ddrc"]} {
+		read_client_prefs_from "defaults.ddrc"
+	} else {
+		read_client_prefs_from [file join [file dirname [file dirname $::argh0]] "lib/pd/bin/defaults.ddrc"]
+	}
+	if {[file exists $::cmdline(ddrcfilename)]} {
+		read_client_prefs_from $::cmdline(ddrcfilename)
+	}
+}
+read_ddrc
+
+#-----------------------------------------------------------------------------------#
+
+set cmdline(port) 0
+set cmdline(gdb) 0
+set cmdline(gdbconsole) 1
+set cmdline(valgrind) 0
+if {$look(View:language) eq "auto"} {
+	set language [guess_lang]
+} else {
+	set language $look(View:language)
+}
+
+set files_to_open {}
+
+proc cmdline_help {} {
+  puts "DesireData commandline options:
+  -serverargs (for future use)
+      -server   select the executable for the pd server
+         -gdb   run pd server through gdb
+   -manualgdb   run gdb in the terminal
+    -valgrind   run pd server through valgrind
+  -novalgrind   ... or don't
+  -safemode     run desiredata with all default settings
+  -dzinc        use zinc emulation"
+}
+
+for {set i 0} {$i < $argc} {incr i} {
+  global cmdline files_to_open
+  set o [lindex $argv $i]
+  switch -regexp -- $o {
+          ^-port\$ {incr i; set cmdline(port) [lindex $argv $i]}
+    ^-serverargs\$ {error "not supported yet"}
+    ^-server\$  {incr i; set cmdline(server)  [lindex $argv $i]}
+           ^-gdb\$ {set cmdline(gdb) 1}
+     ^-manualgdb\$ {set cmdline(gdbconsole) 0}
+      ^-valgrind\$ {set cmdline(valgrind) 1}
+    ^-novalgrind\$ {set cmdline(valgrind) 0}
+    ^-safemode\$ {set cmdline(safemode) 1}
+    ^-dzinc\$ {set cmdline(dzinc) 1}
+    ^(-h|-help|--help)\$ {cmdline_help; exit 1}
+    ^- {puts "ERROR: command line argument: unknown $o"}
+    default {lappend files_to_open [lindex $argv $i]}
+  }
+}
+
+#set cmdline(server) \"$cmdline(server)\"
+set encoding ""
+set langoptions {
+	english francais deutsch catala espanol portugues italiano bokmal
+	euskara polski dansk chinese nihongo brasiliano turkce nederlands
+	russkij
+
+}
+#lappend langoptions {chinese}
+#lappend langoptions {esperanto}
+set langfile locale/[switch -regexp -- $language {
+  ^(en|english|C)$    {list english}
+  ^(fr|francais)$     {list francais}
+  ^(de|deutsch)$      {list deutsch}
+  ^(ca|catala)$       {list catala}
+  ^(es|espanol)$      {list espanol}
+  ^(pt|portugues)$    {list portugues}
+  ^(it|italiano)$     {list italiano}
+  ^(nb|norsk|bokmal)$ {list bokmal}
+  ^(ch|chinese)$      {set encoding utf-8; list chinese}
+  ^(eu|euskara)$      {list euskara}
+  ^(eo|esperanto)$    {set encoding utf-8; list esperanto}
+  ^(pl|polski)$       {set encoding utf-8; list polski}
+  ^(dk|dansk)$        {list dansk}
+  ^(ja|japanese|nihongo)$ {list nihongo}
+  ^(br|brasiliano)$   {list brasiliano}
+  ^(tr|turkce)$       {set encoding utf-8; list turkce}
+  ^(nl|nederlands)$   {list nederlands}
+  ^(ru|russkij)$      {set encoding utf-8; list russkij}
+  default {error "huh??? unknown language (locale)"}
+}].tcl
+
+proc localedir {x} {file join [file dirname [file dirname $::argh0]] lib/pd/bin/$x}
+if {[regexp {desire\.tk$} $argh0]} {
+	source locale/index.tcl
+	if {$encoding != ""} {source -encoding $encoding $langfile} else {source $langfile}
+} else {
+	source [localedir locale/index.tcl]
+	if {$encoding != ""} {source -encoding $encoding [localedir $langfile]} else {source [localedir $langfile]}
+}
+
+if {[info exists ::cmdline(safemode)]} {read_client_prefs_from "defaults.ddrc"}
+if {[info exists ::cmdline(dzinc)]} {package require dzinc}
+
+#-----------------------------------------------------------------------------------#
+
+#!@#$ is this still valid?
+set look(Box:extrapix) [switch $::OS {
+        osx     {concat 2}
+        default {concat 1}}]
+
+#font is defined as Thing for now, as the completion needs to get to these ones.
+
+#!@#$ View->???
+#set look(View:tooltip) 1
+
+#!@#$ View->TextBox ?
+#set look(View:minobjwidth) 21
+
+#!@#$ View->ObjectBox
+#set look(View:fg) #000000
+#set look(View:bg) #ffffff
+#set look(View:frame1) #99cccc
+#set look(View:frame2) #668888
+#set look(View:frame3) #000000
+
+#!@#$ this is supposed to be BlueBox!
+#set look(Slider:bg) #ccebff
+
+set zoom(canned) [list 25 33 50 75 100 125 150 200 250 300 400]
+set scale_amount 1.1
+################## set up main window #########################
+
+class_new Console {View}
+
+def Console init {c} {
+	set @c $c
+	frame $c
+	text $c.1 -width 72 -height 20 -yscrollcommand "$c.2 set" -font [$self look font]
+	scrollbar $c.2 -command "$c.1 yview"
+	pack $c.1 -side left -fill both -expand yes
+	pack $c.2 -side left -fill    y -expand no
+	pack $c -fill both -expand yes
+	$c.2 set 0.0 1.0
+	switch $::OS { osx {
+		bind $c.1 <MouseWheel> {$c.1 yview scroll [expr -2-abs(%D)/%D] units}
+	}}
+	set @lines 0
+}
+
+def Console widget {} {return $@c}
+
+def Console post_string {x} {
+	set oldpos [lindex [$@c.2 get] 1]
+	$@c.1 insert end $x
+	regsub -all "\n" $x "" y
+	set n [expr [string length $x]-[string length $y]]
+	incr @lines $n
+	while {$@lines >= $::cmdline(console)} {
+		$@c.1 delete 1.0 2.0
+		incr @lines -1
+	}
+	if {$oldpos > 0.9999} {$@c.1 see end}
+}
+
+#class_new Client {Menuable View}
+class_new Client {Menuable Thing}
+
+set ctrls_audio_on 0
+set ctrls_meter_on 0
+
+def Client window {} {return .}
+
+def Client init_binds {} {
+    bind . <Control-Key>       {$main ctrlkey %x %y %K %A 0}
+    bind . <Control-Shift-Key> {$main ctrlkey %x %y %K %A 1}
+    switch $::OS {
+      osx {
+        bind . <Mod1-Key>       {$main ctrlkey %x %y %K %A 0}
+        bind . <Mod1-Shift-Key> {$main ctrlkey %x %y %K %A 1}
+      }
+    }
+#    bind . <Motion> {.debug.1 configure -text "widget = %W"}
+}
+
+# miller uses this nowadays (matju fished it in pd-cvs for 0.40). we don't use it for now.
+# remember to fix all quoting problems, which in the end may or may not involve the following proc.
+proc pdtk_unspace {x} {
+  set y [string map {" " "_" ";" "" "," "" "{" "" "}" "" "\\" ""} $x]
+  if {$y == ""} {set y "empty"}
+  concat $y
+}
+
+proc pdtk_pd_meters {indb outdb inclip outclip} {
+    foreach {z clip db} [list in $inclip $indb out $outclip $outdb] {
+	.controls.$z.1.mtr coords m 0 0 $db 0
+	.controls.$z.1.clip configure -background [if {$clip==1} {concat red} {concat black}]
+    }
+}
+
+proc pd_startup {version apilist midiapilist args} {
+	set ::pd_version $version
+	set ::pd_apilist $apilist
+	set ::pd_midiapilist $midiapilist
+	foreach api $apilist {
+		lappend ::pd_apilist2 "-[string tolower [lindex $api 0]]"
+	}
+	set version [regsub "^DesireData " $::pd_version ""]
+	post "DesireData server version $version"
+}
+
+def Client init_controls {} {
+    menu .mbar
+    pack [frame .controls] -side top -fill x
+    foreach t {file window help} {
+	.mbar add cascade -label [say $t] -menu [menu .mbar.$t -tearoff $::pd_tearoff]
+    }
+    .mbar.window configure -postcommand "$self fix_window_menu"
+    foreach {z fill} {in #0060ff out #00ff60} {
+	set f .controls.$z
+	frame $f
+	frame $f.1 -borderwidth 2 -relief groove
+	canvas $f.1.mtr -width 100 -height 10 -bg #222222
+	    $f.1.mtr create line [list 0 0 0 0] -width 24 -fill $fill -tags m
+	canvas $f.1.clip -width 5 -height 10 -bg #222222
+	pack $f.1.mtr $f.1.clip -side left
+	pack [label $f.2 -text [say $z]:] $f.1 -side left
+	pack $f -side left -pady 0 -padx 0
+    }
+    foreach {w x y z} {
+	    audiobutton audio  ctrls_audio_on {netsend [list pd dsp    $ctrls_audio_on]}
+	    meterbutton meters ctrls_meter_on {netsend [list pd meters $ctrls_meter_on]}
+    } {
+	pack [checkbutton .controls.$w -text [say $x] -variable $y -anchor w -command $z] -side left
+    }
+    button .controls.clear -text [say console_clear] -command {.log.1 delete 0.0 end}         -padx 2 -pady 0
+    button .controls.dio   -text [say io_errors]     -command {netsend [list pd audiostatus]} -padx 2 -pady 0
+    pack .controls.clear .controls.dio -side right
+    if {$::debug} {
+	    frame .debug
+	    pack [label .debug.1 -anchor w -text ""] -side left
+	    pack [entry .debug.3 -textvariable ::serial -width 5] -side right
+	    pack [label .debug.2 -text "obj.serial: " -justify right] -side right
+	    pack .debug -side bottom -fill x
+    }
+    if {$::cmdline(console)} {set ::console [Console new .log]}
+    . configure -menu .mbar
+    wm title . "DesireData"
+    catch {wm iconphoto . icon_pd}
+    regexp {\d\d\d\d/\d\d/\d\d} $::cvsid version
+    regsub -all "/" $version "." version
+    set ::pd_version_client $version
+    post "DesireData client version $version with Tcl %s and Tk %s" $::tcl_patchLevel $::tk_patchLevel
+}
+
+proc pdtk_pd_dsp {value} {
+    global ctrls_audio_on
+    set ctrls_audio_on $value
+}
+
+proc pdtk_pd_dio {red} {
+    .controls.dio configure -background red -activebackground [if {$red==1} {list red} {list lightgrey}]
+}
+
+############### set up global variables ################################
+
+set pd_opendir [pwd]
+
+############### set up socket ##########################################
+set sock {}
+set sock_lobby {}
+
+proc poll_sock {} {
+	global sock sock_lobby cmdline
+	if {[llength $sock]==0} {return}
+	while {1} {
+		set cmd [gets $sock]
+		if {[eof $sock]} {
+			if {!$cmdline(gdb)} {
+				tk_messageBox -message "connection ended by server.\n(crash? try: desire -gdb)" -type ok
+			}
+			set sock {}
+			return
+		}
+		if {[fblocked $sock]} {break}
+		if {$::debug} {if {[string first pdtk_post $cmd]!=0} {puts "[VTmagenta]-> $cmd[VTgrey]"}}
+		append sock_lobby "\n$cmd"
+		if {[catch {eval $sock_lobby}]} {
+			global errorCode errorInfo
+			switch -regexp -- $errorInfo { "^missing close-brace" {
+				#puts "waiting for the end of: [string range $sock_lobby 0 40]"
+				continue
+			}}
+			error_dump
+		}
+		set sock_lobby {}
+	}
+	flush $sock
+	after 50 poll_sock
+}
+
+set server_pid 0
+proc poll_gdb {} {
+	global gdb
+	while {1} {
+		set line [gets $gdb]
+		if {$line=="" || [fblocked $gdb]} {break} ;# which way should i check for no input?
+		if {[eof $gdb]} {return}
+		regsub {^\(gdb\) ?} $line {} line
+		if {[regexp {^\[Thread debug} $line]} {continue}
+		if {[regexp {^\[New Thread.*LWP (\d+)} $line dummy pid]} {
+			if {!$::server_pid} {
+				set ::server_pid $pid
+				post "server pid=$pid"
+				continue
+			}
+		}
+		if {[regexp {^Reading symbols from} $line]} {continue}
+		if {[regexp {^Using host libthread_db} $line]} {continue}
+		if {[regexp {^Starting program:} $line]} {continue}
+		if {[regexp {^Program received signal (\w+), (.*)\.} $line bogus sig1 sig2]} {
+			set where ""
+			# can anyone figure out why a long backtrace won't be slurped in this case?
+			set timeout [expr [clock seconds]+2]
+			#fconfigure $gdb -blocking 1 -buffering none
+			while {![eof $gdb] && [clock seconds] < $timeout} {
+				set line [gets $gdb]
+				if {$line eq ""} {continue} ;# busy-wait
+				regsub {^\(gdb\) ?} $line {} line
+				append where "$line\n"
+				#puts "where size = [string length $where]"
+			}
+			OopsDialog new $sig1 $sig2 $where
+		}
+		post "\[gdb\] %s" $line
+	}
+	after 100 poll_gdb
+}
+
+proc pd_connect {} {
+	global sock
+	if {[catch {set sock [socket 127.0.0.1 13666]}]} {
+		post "can't connect... wait a second"
+		after 1000 pd_connect
+		return
+	}
+	post "Connected to server"
+	fconfigure $sock -blocking 0 -buffering line
+	netsend [list pd init]
+	poll_sock
+	foreach f $::files_to_open {
+		set ff [file split [file normalize $f]]
+		set ffl [llength $ff]
+		set file [lindex $ff [expr $ffl-1]]
+		set dir [join [lrange $ff 0 [expr $ffl-2]] [file separator]]
+		netsend [join [list pd open $file $dir]]
+	}
+}
+
+set server_port 13666
+after 1000 pd_connect
+
+after 0 {
+  if {$cmdline(port)} {
+	set server_port $cmdline(port)
+	# and then do nothing...
+  } elseif {$cmdline(valgrind)} {
+	#exec valgrind --tool=memcheck $cmdline(server) -guiport $server_port &
+	exec valgrind --tool=memcheck --gen-suppressions=all --suppressions=valgrind3.supp $cmdline(server) -guiport $server_port &
+  } else {
+    if {$cmdline(gdb)} {
+	if {$cmdline(console) && $cmdline(gdbconsole)} {
+	    set gdb [open "| gdb --quiet 2&>1" w+]
+	    fconfigure $gdb -blocking 0 -buffering none
+	    puts $gdb "file \"$cmdline(server)\"" ;# bad quoting, sorry
+	    puts $gdb "run -guiport $server_port"
+	    puts $gdb "where"
+	    puts $gdb "quit"
+	    flush $gdb
+	    after 0 poll_gdb
+	} else {
+	    exec gdb --args $cmdline(server) -guiport $server_port &
+	    #exec gdb --tui --args $cmdline(server) -guiport $server_port &
+	}
+    } else {
+	exec $cmdline(server) -guiport $server_port &
+    }
+  }
+}
+
+################ utility functions #########################
+
+proc enquote {x} {
+    set foo [string map {"," "" ";" "" "\"" ""} $x]
+    return [string map {" " "\\ " "{" "" "}" ""} $foo]
+}
+
+proc pdtk_watchdog {} {netsend [list pd ping]; after 2000 {pdtk_watchdog}}
+
+proc accel_munge {acc} {
+    switch $::OS {
+      osx {
+        set tmp [string toupper [string map {Ctrl Meta} $acc] end]
+	if [string is upper [string index $acc end]] {
+	    return Shift+$tmp
+	} else {
+	    return $tmp
+	}
+      }
+      default {return $acc}
+    }
+}
+
+# a menuable must be a View
+# and it must have a window so that the Menuable methods work
+# it could be renamed to Windowed
+class_new Menuable {}
+def Menuable init {args} {
+	eval [concat [list super] $args]
+	set @accel {}
+	set @menubar .$self.m
+}
+
+# this doesn't have to do with menus, only with toplevel windows.
+def Menuable raise {} {
+	set w [$self window]
+	set w $w.c
+	raise $w
+	focus -force $w
+}
+
+set untitled_number 1
+set untitled_folder [pwd]
+
+# just a dummy proc
+proc none {args} {}
+
+def Client new_file {} {
+	global untitled_number untitled_folder
+	netsend [list pd filename Untitled-$untitled_number $untitled_folder]
+	netsend [list #N canvas]
+	netsend [list #X pop 1]
+	incr untitled_number
+}
+
+
+set patch_filetypes {
+	{"pd files"  ".pd"}
+	{"max files" ".pat"}
+	{"all files" "*"}
+}
+
+set image_filetypes {
+	{"image files" ".gif .png"}
+	{"gif files"  ".gif"}
+	{"png files" ".png"}
+	{"all files" "*"}
+}
+
+#only works with tcltk 8.5
+catch {tk_getOpenFile -load-once}
+if {$tcl_version>=8.5} {
+	set ::tk::dialog::file::showHiddenBtn 1
+	set ::tk::dialog::file::showHiddenVar 0
+}
+
+def Client open_file {} {
+    global pd_opendir patch_filetypes
+    set filename [tk_getOpenFile -defaultextension .pd -filetypes $patch_filetypes -initialdir $pd_opendir]
+    if {$filename != ""} {$self open_file_really $filename}
+}
+
+def Client open_file_really {filename} {
+    set i [string last / $filename]
+    set folder [string range $filename 0 [expr $i-1]]
+    set ::pd_opendir $folder
+    set basename [string range $filename [expr $i+1] end]
+    if {[string last .pd $filename] >= 0} {
+	    netsend [list pd open [enquote $basename] [enquote $folder]]
+    }
+}
+
+def Client send_message {} {
+    toplevel .sendpanel
+    set e .sendpanel.entry
+    pack [entry $e -textvariable send_textvar] -side bottom -fill both -ipadx 100
+    $e select from 0
+    $e select adjust end
+    bind $e <KeyPress-Return> {netsend $send_textvar; after 50 {destroy .sendpanel}}
+    focus $e
+}
+
+def Client quit {} {
+	set answer [tk_messageBox -message "Do you really wish to quit?" -type yesno -icon question]
+	switch -- $answer {yes {netsend [list pd quit]; exit}}
+}
+
+def Client abort_server {} {
+	set answer [tk_messageBox -message "Do you really wish to abort?" -type yesno -icon question]
+	switch -- $answer {yes {exec kill -ABRT $::server_pid}}
+}
+
+def Client server_prefs {} {ServerPrefsDialog new_as pdrc}
+def Client client_prefs {} {ClientPrefsDialog new_as ddrc}
+
+proc menu_pop_pd {} {raise .}
+
+def Menuable populate_menu {menu list} {
+	global key
+	if {[string index $menu 0] != "."} {set menu $@menubar.$menu}
+	foreach name $list {
+		if {$name == ""} {$menu add separator; continue}
+		set k ""
+		if {[info exists key($@_class:$name)]} {
+			if {[string length $key($@_class:$name)]} {set k $key($@_class:$name)}
+		}
+		$menu add command -label [say $name] -command "$self $name" -accelerator [accel_munge $k]
+	}
+}
+
+def Client init_menus {} {
+    #removed paths after send_message
+    $self populate_menu file {
+        new_file open_file {}
+	server_prefs client_prefs send_message {}
+	audio_on audio_off {}
+	abort_server quit}
+    $self populate_menu help {
+	about documentation class_browser do_what_i_mean {}
+	test_audio_and_midi load_meter latency_meter {}
+	clipboard_view command_history_view event_history_view keyboard_view client_class_tree}
+}
+
+def Client init {} {
+  super
+  set @menubar .mbar
+  $self init_controls
+  $self init_binds
+  $self init_menus
+  # it's necessary to raise the window on OSX
+  switch $::OS { osx {raise .; wm iconify .; after 100 {wm deiconify .}}}
+  after 0 {
+	  Listener new .tcl [say "tcl_console"] tcl_eval
+	  Listener new .pd  [say "pd_console"]  pd_eval
+  }
+  #wm geometry .[$self keyboard_view] -0+0
+  #wm geometry .[$self event_history_view] -0-0
+}
+
+proc post {args} {
+	set s "[eval [linsert $args 0 format]]\n"
+	#	set s "[info level -1]: $s"
+	if {$::cmdline(console)} {$::console post_string $s} else {puts stderr $s}
+}
+proc pdtk_post {s} {
+	if {$::cmdline(console)} {$::console post_string $s} else {puts stderr $s}
+}
+
+def Menuable eval% {code} {
+	regsub -all %W $code $self code
+	uplevel [info level] $code
+}
+
+def Menuable getkey {k} {
+	global accels
+	if {[dict exists $accels $k]} {
+		set vars [dict get $accels $k]
+		foreach var $vars {
+			#mset {class key} [split [dict get $accels $k] ":"]
+			mset {class key} [split $var ":"]
+			#if {$class != $@_class} {return ""} else {return $key}
+			if {$class == $@_class} {return $key}
+		}
+	}
+}
+
+def Menuable ctrlkey {x y key iso shift} {
+	set key [if {$shift} {string toupper $key} {string tolower $key}]
+	set key "Ctrl+$key"
+	set cmd [$self getkey $key]
+	if {![string length $cmd]} {
+		switch [$self class]:$key {
+			#explicitly listed here to do nothing
+			Client:Ctrl+c {}
+			Client:Ctrl+v {}
+			default {post "unknown key $key"}
+		}
+	} else {$self eval% "%W $cmd"}
+}
+
+def Menuable altkey {x y key iso shift} {
+    set key [if {$shift} {string toupper $key} {string tolower $key}]
+    set key "Alt+$key"
+    set cmd [$self getkey $key]
+    if {[string length $cmd]} {$self eval% "%W $cmd"} else {post "unknown key $key"}
+}
+
+#-----------------------------------------------------------------------------------#
+set pd_apilist "{ALSA 1}"
+set pd_apilist2 "default"
+
+#-----------------------------------------------------------------------------------#
+#fixme: actually, is it ok that View<Menuable ? --matju
+class_new View {Menuable Observable Thing}
+
+# normally ninlets/noutlets should be in class "Box", but server-side isn't smart enough
+def View  pdclass= {v}    {set @pdclass $v}
+def View  pdclass  {} {return $@pdclass}
+def View  ninlets= {v}    {set  @ninlets $v}
+def View  ninlets  {} {return  $@ninlets}
+def View noutlets= {v}    {set @noutlets $v}
+def View noutlets  {} {return $@noutlets}
+def View   click {x y f target} {}
+def View unclick {x y f target} {}
+def View  motion {x y f target} {}
+
+def View subpatch {} {if {[info exists @subpatch]} {return 1} else {return 0}}
+
+def View look_cache {k} {
+	global look look_cache
+	foreach super [$@_class ancestors] {
+		if {[info exists look($super:$k)]} {
+			set look_cache($@_class:$k) $super
+			return $super
+		}
+	}
+}
+def View look {k} {
+	if {![info exists ::look_cache($@_class:$k)]} {$self look_cache $k}
+	return   $::look($::look_cache($@_class:$k):$k)
+}
+
+def View init {} {
+	super
+	set @selected? 0
+	set @index 0xDEADBEEF
+	set @ninlets 1  ;# should be in Box init
+	set @noutlets 0 ;# should be in Box init
+	set @canvas ""
+#	set @inside_box 42 ;# temporary fix
+	set @ioselect {}
+}
+
+def View classtags {} {return {foo}}
+
+set item {
+	set canvas [$self get_canvas] 
+	if {$canvas == ""} {return}
+	set c [$self cwidget]
+	set zoom [$canvas zoom]
+	set coords [lmap * $coords $zoom]
+	set find [lsearch $args "-width"]
+	if {$find >= 0} {
+		incr find
+		set w [lindex $args $find]
+		lset args $find [format %.0f [expr {$w*$zoom}]]
+	}
+	set find [lsearch $args "-font"]
+	if {$find >= 0} {
+		incr find
+		set fs [lindex [lindex $args $find] 1]
+		lset args $find 1 [format %.0f [expr {$fs*$zoom}]]
+	}
+	set tags {}
+	foreach s $suffixes {lappend tags "$self$s"}
+	set ss [lindex $tags 0]
+	lappend tags $self
+	set tags [concat $tags [$self classtags]]
+}
+if {$have_expand} {
+    append item {
+	if {![llength [$c gettags $ss]]} {
+		$c create $type $coords -tags $tags {expand}$args
+	} {
+		$c itemconfigure $ss {expand}$args
+		$c coords        $ss {expand}$coords
+	}
+    }
+} else {
+    append item {
+	if {![llength [$c gettags $ss]]} {
+		eval [concat [list $c create $type $coords -tags $tags] $args]
+	} {
+		eval [concat [list $c itemconfigure $ss] $args]
+		eval [concat [list $c coords        $ss] $coords]
+	}
+    }
+}
+def View item {suffixes type coords args} $item
+
+def View item_delete {{suffix all}} {
+	if {$@canvas == ""} {return}
+	set c [$@canvas widget]
+	if {![winfo exists $c]} {
+		set canvas [$@canvas get_canvas]
+		if {$canvas == ""} {return}
+		set c [[$@canvas get_canvas] widget]
+		if {![winfo exists $c]} {return}
+	}
+	switch -- $suffix {
+		all     {$c delete $self}
+		default {$c delete $self$suffix}}
+}
+
+def View draw {} {}
+
+def View delete {} {$self erase; super}
+def View erase {} {$self item_delete}
+def View selected?  {}  {return $@selected?}
+def View selected?= {x} {set @selected? $x; $self changed} ;# this is for use by the Selection class only
+def View edit? {} {if {[info exists @edit]} {return $@edit} else {return 0}}
+def View select {state} {
+	set ostate [$self selected?]
+	set @selected? $state
+	if {$state!=$ostate} {$self changed}
+}
+
+# give topleft point of an object in the canvas it's rendered in.
+# this includes GOP and excludes zoom.
+# inheritance problem: this doesn't work for Wire, which doesn't store its positions
+def View xy {} {
+	if {$@canvas == ""} {return [list $@x1 $@y1]}
+	set type [$@canvas type]
+	if {$type == "gopabs" || $type == "gopsub"} {
+		mset {xmargin ymargin} [$@canvas margin]
+		mset {x y} [$@canvas xy]
+		set x1 [expr {($@x1-$xmargin)+$x}]
+		set y1 [expr {($@y1-$ymargin)+$y}]
+		#if $self's gop is opened
+		if {[regexp {^.x[0-9a-f]{6,8}.c} [focus] f]} {
+			if {$f == ".$@canvas.c"} {set x1 $@x1; set y1 $@y1}
+		}
+		#if {[focus] != "." && [focus] == ".$@canvas.c"} {set x1 $@x1; set y1 $@y1}
+		return [list $x1 $y1]
+	}
+	return [list $@x1 $@y1]
+}
+
+def View canvas  {}  {return $@canvas}
+def View canvas= {c} {
+	set @canvas $c
+	# should "subscribe" call "changed"? (or pretend to?)
+	$self subscribe $c
+	$self changed
+	$self outside_of_the_box
+}
+
+def View visible {} {if {[info exists @inside_box]} {return $@inside_box} {return -1}}
+
+# this returns the canvas actually exists/drawn
+# see also def Canvas get_canvas
+def View get_canvas {} {
+	set canvas $@canvas
+	if {$canvas == ""} {return ""}
+	#while {![$canvas havewindow]} {set canvas [$canvas canvas]}
+	while {![winfo exists [$canvas widget]]} {set canvas [$canvas canvas]}
+	return $canvas
+}
+# this will return the top level gop if gop is nested
+def View get_parent_gop {canvas} {
+	set obj $self
+	while {$canvas != [$obj canvas]} {set obj [$obj canvas]}
+	return $obj
+}
+
+def View outside_of_the_box {} {
+	if {$@canvas eq ""} {return}
+	# always hide these things
+	if {[$self class] == "Wire"}       {set @inside_box 0; return}
+	if {[$self class] == "ObjectBox"}  {set @inside_box 0; return}
+	if {[$self class] == "MessageBox"} {set @inside_box 0; return}
+	if {[$self class] == "Comment"}    {set @inside_box 0; return}
+	if {[$self class] == "Array"} {$@canvas visibles+= $self; set @inside_box 1; return}
+	set x1 $@x1; set y1 $@y1
+	if {[$@canvas gop]} {
+		set mess [$@canvas get_mess]
+		set pixwidth [lindex $mess 4]
+		set pixheight [lindex $mess 5]
+		if {[llength $mess] == 6} {
+			set xmargin 0; set ymargin 0
+		} else {
+			set xmargin [lindex $mess 6]; set ymargin [lindex $mess 7]
+		}
+		if {$x1 < $pixwidth +$xmargin && $x1 > $xmargin && \
+		    $y1 < $pixheight+$ymargin && $y1 > $ymargin} {
+			set @inside_box 1
+			$@canvas visibles+= $self
+		} else {
+			set @inside_box 0
+			$@canvas visibles-= $self
+		}
+	} else {set @inside_box 1}
+}
+
+def View draw_maybe {} {
+	if {$@canvas == "" && [winfo exists .$self.c]} {$self draw; return}
+	if {[$self class] == "Canvas" && $@canvas == ""} {return}
+	if {$@inside_box} {
+		#if {[$@canvas mapped] && ![$@canvas abs] && [$self gop_check]} {$self draw}
+		if {[$@canvas mapped] && [$self gop_check]} {$self draw}
+	} else {
+		# for drawing opened gop
+		if {[winfo exists .$@canvas.c]} {$self draw}
+	}
+}
+#this checks if $self can be seen, ie nested gop.
+def View gop_check {} {
+	set canvases $@canvas
+	while {[lindex $canvases end] != ""} {lappend canvases [[lindex $canvases end] canvas]}
+	set canvases [lreplace $canvases end-1 end]; # all canvases
+	foreach canvas $canvases {
+		# if a canvas is not a gop and its window does not exists
+		if {![$canvas gop] && ![winfo exists [$canvas widget]]} {return 0; break}
+	}
+	return 1
+}
+
+#-----------------------------------------------------------------------------------#
+
+class_new Canvas {Menuable ObjectBox}
+
+def Canvas close {} {
+	after cancel $@motion_after_id
+	if {$@subpatch} {
+		#can't wait till @mapped get updated thru proc change
+		if {$@gop} {foreach x [$@objects values] {$x outside_of_the_box}}
+		$self save_geometry
+		$self copy_times= 0
+		netsend [list .$self vis 0]
+		#netsend [list .$self close]
+		return
+	}
+	if {$@gop} {
+		foreach x [$@objects values] {$x outside_of_the_box}
+		netsend [list .$self close]
+		return
+	}
+	switch [tk_messageBox -message [say save_changes?] -icon question -type yesnocancel -default cancel] {
+		yes    {$self save; netsend [list .$self close]}
+		no     {            netsend [list .$self close]}
+		cancel {}
+	}
+}
+
+def Canvas save_geometry {} {
+	set geometry [wm geometry .$self]
+	set cw [winfo width [$self widget]]; set ch [winfo height [$self widget]]
+	foreach {size x y} [split $geometry "+"] {mset {w h} [split $size "x"]; set x1 $x; set y1 $y}
+	set x2 [expr $x1+$cw]; set y2 [expr $y1+$ch]
+	netsend [list .$self bounds $x1 $y1 $x2 $y2]
+}
+
+def Canvas save {} {
+	if {$@subpatch} {return [$@canvas save]}
+	$self checkgeometry
+	set c [$self widget]
+	if {![regexp {^Untitled-[0-9]} $@name]} {
+		$self save_geometry
+		netsend [list .$self savetofile $@name $@folder]
+	} else {
+		$self save_as
+	}
+}
+
+def Canvas save_as {} {
+	$self checkgeometry
+	set filename [tk_getSaveFile -filetypes $::patch_filetypes]
+	if {$filename != ""} {
+		set @file   [string range $filename [expr [string last / $filename]+1] end]
+		set @folder [string range $filename 0 [expr [string last / $filename]-1]]
+		$self save_geometry
+		puts "save $@file dir to $@folder"
+		netsend [list .$self savetofile $@file $@folder]
+	}
+}
+
+def Canvas print {} {
+    set filename [tk_getSaveFile -initialfile pd.ps -defaultextension .ps -filetypes { {{postscript} {.ps}} }]
+    if {$filename != ""} {[$self widget] postscript -file $filename}
+}
+def Canvas quit {}         {$::main quit}
+def Canvas abort_server {} {$::main abort_server}
+
+proc wonder {} {tk_messageBox -message [say ask_cool] -type yesno -icon question}
+
+def Canvas eval% {code} {
+	mset {x y} $@curpos
+	regsub -all %X $code $x code
+	regsub -all %Y $code $y code
+	super $code
+}
+
+def Client documentation {} {
+    set filename [tk_getOpenFile -defaultextension .pd -filetypes { {{documentation} {.pd .txt .htm}} } -initialdir $::docdir]
+    if {$filename != ""} {
+        if {[string first .txt $filename] >= 0} {
+            menu_opentext $filename
+        } elseif {[string first .htm $filename] >= 0} {
+            menu_openhtml $filename
+        } else {
+            set i [string last / $filename]
+            set help_directory [string range $filename 0 [expr $i-1]]
+            set basename       [string range $filename   [expr $i+1] end]
+            netsend [list pd open [enquote $basename] [enquote $help_directory]]
+        }
+    }
+}
+
+def Canvas     new_file {} {$::main  new_file}
+def Canvas    open_file {} {$::main open_file}
+def Canvas send_message {} {$::main send_message}
+def Client test_audio_and_midi {} {menu_doc_open doc/7.stuff/tools testtone.pd  }
+def Client          load_meter {} {menu_doc_open doc/7.stuff/tools load-meter.pd}
+def Client       latency_meter {} {menu_doc_open doc/7.stuff/tools latency.pd   }
+def Client about {} {AboutDialog new}
+def Client class_browser {} {Browser new_as browser browser 0 0 ""}
+def Client audio_on  {} {netsend [list pd dsp 1]}
+def Client audio_off {} {netsend [list pd dsp 0]}
+def Client        keyboard_view {} {    KeyboardDialog new $::event_history}
+def Client       clipboard_view {} {   ClipboardDialog new $::clipboard}
+def Client command_history_view {} {        ListDialog new $::command_history [say command_history_view]}
+def Client   event_history_view {} {EventHistoryDialog new $::event_history}
+def Client do_what_i_mean {} {wonder}
+
+set pd_prefix [file dirname [file dirname [which pd]]]
+set pd_guidir ${pd_prefix}/lib/pd
+set doc_number 1
+set updir [file dirname [file dirname $argh0]]
+if {[file exists $updir/lib/pd/doc]} {
+	set docdir $updir/lib/pd/doc
+} else {
+	set docdir $updir/doc
+}
+
+proc menu_opentext {filename} {
+    set w [format ".help%d" $::doc_number]
+    toplevel $w
+    wm title $w $filename
+    frame $w.1
+    frame $w.2
+    pack [text $w.1.text -relief raised -bd 2 -yscrollcommand "$w.1.scroll set"] -side left -fill both -expand 1
+    pack [scrollbar $w.1.scroll -command "$w.1.text yview"] -side right -fill y
+    pack [button $w.2.close -text [say close] -command "destroy $w"] -side right
+    pack $w.2 -side bottom -fill    x -expand 0
+    pack $w.1 -side bottom -fill both -expand 1
+    set f [open $filename]
+    while {![eof $f]} {
+    	set bigstring [read $f 1000]
+	regsub -all PD_BASEDIR $bigstring $::pd_guidir bigstring
+    	regsub -all PD_VERSION $bigstring $::pd_version bigstring
+    	$w.1.text insert end $bigstring
+    }
+    $w.1.text configure -state disabled
+    close $f
+    incr ::doc_number
+    return $w
+}
+
+proc menu_doc_open {subdir basename} {
+    set dirname $::pd_guidir/$subdir
+    if {[string first .txt $basename] >= 0} {
+    	return [menu_opentext $dirname/$basename]
+    } else {
+    	netsend [list pd open $basename $dirname]
+    }
+}
+
+#-----------------------------------------------------------------------------------#
+def Canvas editmode {} {return $@editmode}
+def Canvas editmode= {mode} {
+    if {$mode == $@editmode} {return}
+    if {!$mode} {$self deselect_all}
+    $self redraw ;# why this???
+    set @editmode $mode; $self changed editmode
+#    catch {.$self.bbar.edit configure -image icon_mode_$mode}
+    if {$@mapped} {
+      if {$mode} {set im icon_mode_edit} else {set im icon_mode_run}
+      [$self window].bbar.edit configure -image $im
+      if {[$self look hairstate] && !$@editmode} {$@crosshair erase}
+	    if {[$self look gridstate]} {
+		    if {$@editmode} {$@grid draw} else {$@grid erase}
+	    }
+    }
+    # comment's look depends on the value of @editmode
+    foreach child [$@objects values] {if {[[$child class] <= Comment]} {$child changed}}
+    #!@#$ should update the checkbox in the editmenu
+}
+
+def Canvas editmodeswitch {} {$self editmode= [expr !$@editmode]}
+
+def Canvas window {} {
+	#if {$@gop && $@canvas != ""} {return [$@canvas window]}
+	return .$self
+}
+def Canvas widget {} {return .$self.c}
+def View  cwidget {} {return .[$self get_canvas].c}
+
+#-----------------------------------------------------------------------------------#
+
+def Canvas atomically {proc} {$@history atomically $proc}
+def Canvas undo {} {$@history undo}
+def Canvas redo {} {$@history redo}
+
+def Canvas init {mess} {
+    set @mapped 0
+    set @gop 0
+    set @goprect ""
+    set @abs 0
+    set @name ""
+    set @folder "???"
+    set @file ""
+    super {#X obj 666 666 pd} ;# bogus
+    $self reinit $mess
+    set @zoom 1.0 ;# must be a float, not int
+    set @action none
+    set @objects [Hash new]; set @objectsel [Selection new]; set @visibles {}
+    set   @wires [Hash new]; set   @wiresel [Selection new]
+
+    set @focus ""
+    set @curpos {30 30}
+    set @bbox {0 0 100 100}
+    set @dehighlight {}
+#    if {$@mapped} {$self init_window} ;#!@#$ @mapped can't possibly be 1 at this point
+    set @history $::command_history
+    $self subscribe $::manager
+    $self changed
+    #$self canvas= $self ;#!@#$ EEVIL
+    set @coords 0
+    set @jump 0
+    set @keynav_iocount 0  ;# the io select count
+    set @keynav_port 0     ;# which in/outlet is selected
+    set @keynav 0          ;# the list of objects that has io selected
+    set @keynav_iosel 0    ;# last object that is io selected
+    set @keynav_iosel_o {} ;# list of objects that has outlet selected
+    set @keynav_iosel_i {} ;# list of objects that has inlet selected
+    set @iosel_deselect 0  ;# if selected should be deselected by clicking at empty space
+    set @keynav_current 0
+    set @keynav_last_obj 0
+    set @keynav_last_wire 0
+    set @keynav_tab_sel "wire"
+    set @keynav_shift 0
+    set @copy_count 0
+    set @findbar ""
+    set @find_string ""
+    set @iohilite {-1 0 0 0 0}
+    set @keyprefix 0
+    set @coords {0 0 1 1} ;# default #X coords line
+    set @pixsize {0 0}
+    set @margin {0 0}
+    set @macro_q {}
+    set @macro_delay 200
+    set @blinky ""
+    set @editmode 0
+    set @show_id 0
+    set @motion_queue {}
+}
+
+def Canvas reinit {mess} {
+  switch -- [lindex $mess 0] {
+    "#N" {
+	# those four are not to be confused with other @variables of similar names.
+	set @canvas_pos [lrange $mess 2 3]
+	set @canvas_size [lrange $mess 4 5]
+	set args [lrange $mess 6 end]
+	switch [llength $args] {
+	  1 {
+		set @subpatch 0
+		mset [list @fontsize] $args
+		set @name ""
+		set @mapped 1
+	  }
+	  2 {
+		  set @subpatch 1
+		  mset [list @name @mapped] $args
+		  set @fontsize "what?"
+	  }
+	  default {error "wrong number of arguments (expecting 5 or 6, got [expr 4+[llength $args]])"}
+        }
+    }
+    "#X" {
+      switch -- [lindex $mess 1] {
+        obj {}
+	restore {
+	  set @x1 [lindex $mess 2]
+	  set @y1 [lindex $mess 3]
+	  set args [lrange $mess 4 end]
+	  $self text= [lrange $mess 4 end]
+		if {!$@subpatch && [llength $args] != 0} {set @abs 1}
+		if {$@mapped && !$@gop} {
+			#if {!$@subpatch && $@text != ""} {set @abs 1; return}
+			#if {![winfo exists .$self.c]} {$self init_window}
+		}
+	}
+	coords {
+	  set @coords  [lrange $mess 2 5]
+	  set @pixsize [lrange $mess 6 7]
+	  switch [llength $mess] {
+	    8  {set @gop 0}
+	    9  {set @gop [lindex $mess 8]}
+	    11 {
+		set @gop [lindex $mess 8]
+		set @margin [lrange $mess 9 10]
+	    }
+	    default {error "what???"}
+          }
+	  if {$@gop} {set @mapped 1}
+	}
+      }
+    }
+    "" {return}
+    default {error "huh? mess=$mess"}
+  }
+}
+
+# doesn't this look like Canvas deconstruct ?
+def Canvas get_mess {} {
+	return [concat $@coords $@pixsize $@margin]
+}
+
+
+def Canvas margin {} {return $@margin}
+def Canvas gop {} {return $@gop}
+def Canvas hidtext {} {return $@hidetext}
+def Canvas abs {} {return $@abs}
+#def Canvas abs {} {if {!$@subpatch} {return 1} else {return 0}}
+def Canvas subpatch {} {return $@subpatch}
+def Canvas get_dimen {} {return $@canvas_size}
+
+def Canvas gop_rect {} {
+	mset {pxs pys} $@pixsize
+	mset {mx my} $@margin
+	set rect [list $mx $my [expr $mx+$pxs] [expr $my+$pys]]
+	if {$@goprect == ""} {
+		set @goprect [GopRect new $self $rect]
+	} elseif {!$@editmode} {$@goprect delete; set @goprect ""; return}
+	$@goprect draw
+
+}
+
+# should be called once and only from init
+def Canvas init_window {} {
+    lappend ::window_list $self
+    set win .$self
+    set c [$self widget]
+    if {$::tcl_platform(platform) == "macintosh"} {
+	    toplevel $win -menu $win.m
+    } else {
+	    if {[$self look menubar]} {toplevel $win -menu $win.m} else {toplevel $win -menu ""}
+
+    }
+    catch {wm iconphoto $win icon_pd}
+    set @menubar $win.m
+    $self init_menus
+    # turn buttonbar on/off
+    set @buttonbar [ButtonBar new $self]
+    if {[$self look buttonbar]} {pack [$@buttonbar widget] -side top -fill x -expand no}
+    set @statusbar [StatusBar new $self]
+    # turn statusbar on/off
+    if {[$self look statusbar]} {pack [$@statusbar widget] -side bottom -fill x}
+    set w [expr [lindex $@canvas_size 0]-4];# dd canvas is 4 pixel out with pd canvas? 
+    set h [expr [lindex $@canvas_size 1]-4]   
+    pack [canvas $c -width $w -height $h -background white] -side left -expand 1 -fill both
+    set @yscroll $win.yscroll; set @xscroll $win.xscroll
+    $self init_scrollbars
+    wm minsize $win 1 1
+    wm geometry $win +[lindex $@canvas_pos 0]+[lindex $@canvas_pos 1]
+    wm protocol $win WM_DELETE_WINDOW "$self close"
+    focus $c
+    $self new_binds
+    $self update_title
+    $self motion_update
+    set @runcommand [Runcommand new .$self "command" canvas_eval]
+    set @crosshair [Crosshair new $self]
+    set @active [Active new $self]
+    set @sense [Sense new $self]
+    set @grid [Grid new $self]
+}
+
+def Canvas activate_menubar= {val} {if {$val} {.$self configure -menu $@menubar} {.$self configure -menu ""}}
+
+def Canvas activate_buttonbar= {val} {
+	if {$val} {
+		pack [$@buttonbar widget] -side top -fill x -expand no -before [$self widget]
+	} else {pack forget [$@buttonbar widget]}
+}
+
+def Canvas activate_statusbar= {val} {
+	if {$val} {
+		if {[winfo exists $@yscroll]} {set w .$self.yscroll} else {set w .$self.c}
+		pack [$@statusbar widget] -side bottom -fill x -before $w
+	} else {pack forget [$@statusbar widget]}
+}
+
+def Canvas activate_scrollbars= {val} {if {!$val} {$self init_scrollbars} {$self remove_scrollbars}}
+
+def Canvas activate_grid= {val} {if {$val} {$@grid draw} {$@grid erase}}
+
+def Canvas init_scrollbars {} {
+	set win .$self
+	set c [$self widget]
+	if {[winfo exists $win.yscroll]} {return}
+	set size [$c bbox foo]
+	mset {xs ys} $@canvas_size
+	pack [scrollbar $win.yscroll -command "$c yview"                   ] -side  right -fill y -before $c
+	pack [scrollbar $win.xscroll -command "$c xview" -orient horizontal] -side bottom -fill x -before $c
+	set xw $win.xscroll; set yw $win.yscroll
+	$c configure -yscrollcommand "$self scroll_set $yw" -xscrollcommand "$self scroll_set $xw"
+	after 0 [list $self adjust_scrollbars]
+}
+
+def Canvas remove_scrollbars {} {
+	set win .$self
+	set c [$self widget]
+	if {![winfo exists $win.yscroll]} {return}
+	#use destroy instead of pack forget so that it can be tested with winfo exists
+	destroy $win.yscroll
+	destroy $win.xscroll
+	$c configure -yscrollcommand "" -xscrollcommand "" -scrollregion ""
+}
+
+def Canvas adjust_scrollbars {} {
+	set c [$self widget]
+	set size [$c bbox foo]
+	if {[$self look scrollbar]} {$self auto_scrollbars}
+	if {$size != ""} {
+		mset {xmin ymin xmax ymax} {0 0 100 100}
+		mset {x1 y1 x2 y2} $size
+		if {$x2 > 100} {set xmax $x2}
+		if {$y2 > 100} {set ymax $y2}
+		set bbox [list $xmin $ymin $xmax $ymax]
+		set oldbbox [$c cget -scrollregion]
+		# it is very inefficient to call "configure" here
+		if {"$oldbbox" != "$bbox"} {$c configure -scrollregion $bbox}
+		set @bbox $bbox
+	}
+}
+
+def Canvas auto_scrollbars {} {
+	set c [$self widget]
+	if {[$c bbox foo] != ""} {
+		mset {cx1 cy1 cx2 cy2} [$c bbox foo]
+	}  else {
+		set cx2 [lindex $@canvas_size 0]; set cy2 [lindex $@canvas_size 1]
+	}
+	set x2 [$c canvasx [winfo width $c]]
+	set y2 [$c canvasy [winfo height $c]]
+	if {$x2 == 1} {set x2 $cx2; set y2 $cy2}
+	if {$cx2 <= $x2 && $cy2 <= $y2} {$self remove_scrollbars} {$self init_scrollbars}
+}
+
+def Canvas delete_window {} {
+	set wl {}
+	foreach w $::window_list {if {$w != $self} {lappend wl $w}}
+	set ::window_list $wl
+	destroy .$self
+}
+
+def Canvas delete {} {
+	$self delete_window
+	super
+}
+
+def Canvas focus {} {return $@focus}
+def Canvas focus= {o} {set @focus $o}
+def Canvas history {} {return $@history}
+
+#-----------------------------------------------------------------------------------#
+def Canvas find {} {
+	if {[info exists ::_(findmodel:_class)]} {
+		focus .$self.find.find
+		findmodel reinit
+	} else {
+		FindModel new_as findmodel $self
+		FindView new $self
+		focus .$self.find.find
+	}
+}
+def Canvas find_again {} {
+	if {[info exists ::_(findmodel:_class)]} {findmodel remove_info;findmodel search_recursive}
+}
+
+def Canvas find_last_error {} {netsend [list pd finderror]}
+
+def Canvas bind {eventtype selector args} {
+    set c [$self widget]
+    #bind $c $eventtype [concat [list $self $selector] $args \; $self statusbar_draw %x %y]
+    #bind $c $eventtype "puts \[time {[concat [list $self $selector] $args \; $self statusbar_draw %x %y]}\]"
+    #bind $c $eventtype "puts \[time {[concat [list $self $selector] $args]}\]"
+	if {[$self look statusbar]} {
+		bind $c $eventtype [concat [list $self $selector] $args \; $self statusbar_draw %x %y]
+	} else {
+		bind $c $eventtype [concat [list $self $selector] $args]
+	}
+}
+
+def Canvas new_binds {} {
+    # mouse buttons
+    $self bind <Button>                   click_wrap %x %y %b 0
+    $self bind <Shift-Button>             click_wrap %x %y %b 1
+    $self bind <Control-Button>           click_wrap %x %y %b 2
+    $self bind <Control-Shift-Button>     click_wrap %x %y %b 3
+    $self bind <Alt-Button>               click_wrap %x %y %b 4
+    $self bind <Alt-Shift-Button>         click_wrap %x %y %b 5
+    $self bind <Alt-Control-Button>       click_wrap %x %y %b 6
+    $self bind <Alt-Control-Shift-Button> click_wrap %x %y %b 7
+    switch $::OS {
+      osx {
+        $self bind <Button-2>       click_wrap %x %y %b 8
+        $self bind <Control-Button> click_wrap %x %y 3 8
+      }
+      default {
+        $self bind <Button-3>       click_wrap %x %y %b 8
+      }
+    }
+    switch $::OS { unix {
+	$self bind <Button-4>       scroll y -1
+    	$self bind <Button-5>       scroll y +1
+	$self bind <Shift-Button-4> scroll x -1
+    	$self bind <Shift-Button-5> scroll x +1
+    } default {
+	$self bind <MouseWheel>       scroll y \[expr -abs(%D)/%D\]
+	$self bind <Shift-MouseWheel> scroll x \[expr -abs(%D)/%D\]
+    }}
+    $self bind <ButtonRelease>     	 unclick_wrap %x %y %b 0
+    $self bind <Shift-ButtonRelease>     unclick_wrap %x %y %b 1
+
+    # keyboard
+    $self bind <Control-Key>       ctrlkey %x %y %K %A 0
+    $self bind <Control-Shift-Key> ctrlkey %x %y %K %A 1
+    $self bind <Alt-Key>           altkey  %x %y %K %A 0
+    $self bind <Alt-Shift-Key>     altkey  %x %y %K %A 1
+    switch $::OS {
+      unix {
+	$self bind <Mod1-Key>       altkey %x %y %K %A 0
+	$self bind <Mod1-Shift-Key> altkey %x %y %K %A 1
+	$self bind <Mod4-Key>       altkey %x %y %K %A 0
+	$self bind <Mod4-Shift-Key> altkey %x %y %K %A 1
+      }
+      osx {
+	$self bind <Mod1-Key>       ctrlkey %x %y %K %A 0
+	$self bind <Mod1-Shift-Key> ctrlkey %x %y %K %A 1
+      }
+    }
+    $self bind <Key>               key_wrap   %x %y %K %A 0
+    $self bind <Shift-Key>         key_wrap   %x %y %K %A 1
+    $self bind <KeyRelease>        keyup_wrap %x %y %K %A 0
+    $self bind <Shift-KeyRelease>  keyup_wrap %x %y %K %A 1
+    $self bind <Control-KeyRelease>  keyup_wrap %x %y %K %A 0
+    $self bind <Motion>     motion_wrap %x %y 0
+    $self bind <Alt-Motion> motion_wrap %x %y 4
+    $self bind <Control-Motion> motion_wrap %x %y 9
+    #$self bind <Map>        map
+    #$self bind <Unmap>      unmap
+    $self bind <Leave>      leave
+    $self bind <Configure>  configure %h %w
+}
+
+def Canvas configure {h w} {
+	if {[$self look gridstate]} {
+		$@grid update $h $w
+		if {[winfo exists .$self.yscroll]} {return}; # scrollbar will update grid already
+		$@grid draw
+	}
+}
+
+#def Canvas   map {} {}
+#def Canvas unmap {} {}
+def Canvas leave {} {$@crosshair erase}
+
+def Canvas scroll {axis diff} {
+	set c [$self widget]
+	$c [list $axis]view scroll $diff units
+	if {[$self look hairstate] && $@editmode} {
+		# this should be changed so that we don't need to recompute x,y here.
+		set x [expr [$c canvasx [expr [winfo pointerx $c] - [winfo rootx $c]]]/$@zoom]
+		set y [expr [$c canvasy [expr [winfo pointery $c] - [winfo rooty $c]]]/$@zoom]
+		set target [$self identify_target $x $y 0]
+		$@crosshair data= $x $y $target
+		$@crosshair draw
+	} else {
+		$@crosshair erase
+	}
+}
+
+# this allows the grid to update when scroll
+def Canvas scroll_set {w v1 v2} {if {[$self look gridstate] && $@editmode} {$@grid draw}; $w set $v1 $v2}
+
+def Canvas reload {} {netsend [list .$self reupload]}
+def Canvas redraw {} {
+    $self changed
+    foreach x [$@objects values] {$x changed}
+    foreach x [  $@wires values] {$x changed}
+}
+
+#patch editing commandline shortcuts
+def Canvas o {x y {name ""}} {
+	set c [$self widget]
+	if {[$self snap_grid]} {set off [expr [$self look grid_size]/2]} {set off 0}
+	set @curpos [list [expr [$c canvasx $x]+$off] [expr [$c canvasy $y]+$off]]
+	$self new_object obj $name
+}
+
+def Canvas c {from outlet to inlet} {
+	set out_objs [$self parse_idx $from]
+	set in_objs [$self parse_idx $to]
+	foreach out $out_objs {
+		foreach in $in_objs {
+			$self connect [list $out $outlet $in $inlet]
+		}
+	}
+}
+
+def Canvas pc {from outlet to inlet} {
+	set out_objs [$self parse_idx $from]
+	set in_objs [$self parse_idx $to]
+	if {[llength $out_objs] != [llength $in_objs]} {return "No can do :("}
+	for {set i 0} {$i < [llength $out_objs]} {incr i} {
+		$self connect [list [lindex $out_objs $i] $outlet [lindex $in_objs $i] $inlet]
+	}
+}
+
+def Canvas s {selection} {
+	set objs [$self parse_idx $selection]
+	foreach obj $objs {$self selection+= [$@objects get $obj]}
+}
+
+def Canvas s+ {selection} {
+	set objs [$self parse_idx $selection]; set ids {}
+	foreach obj $objs {
+		set v [$@objects get $obj]; lappend ids $v
+		$self selection+= $v
+	}
+	$self selection_wire= [$self implicit_wires $ids]
+}
+
+def Canvas sw {from outlet to inlet} {
+	set out_objs [$self parse_idx $from]
+	set in_objs [$self parse_idx $to]
+	foreach out $out_objs {
+		foreach in $in_objs {
+			set id [$self wire_idx [list $out $outlet $in $inlet]]
+			if {$id>=0} {$self selection_wire+= [$@wires get $id]}
+		}
+	}
+}
+
+def Canvas parse_idx {val} {
+	set objs {}
+	foreach obj [split $val ","] {
+		if {[regexp {\d+-\d+} $obj range]} {
+			set l [split $range "-"]
+			set objs [concat $objs [lmake [lindex $l 0] [lindex $l 1]]]
+			continue
+		}
+		lappend objs $obj
+	}
+	return $objs
+}
+
+def Canvas xy_snap {x y} {
+	if {[$self look snap_grid]} {
+		set grid [$self look grid_size]
+		set x [expr floor($x/$grid)*$grid]
+		set y [expr floor($y/$grid)*$grid]
+	}
+	return [list $x $y]
+
+}
+
+def Canvas new_object {sel args} {
+	$self editmode= 1
+	$self deselect_all
+	mset {x y} $@curpos
+	if {[$self look snap_grid]} {
+		set grid [$self look grid_size]
+		set x [expr floor($x/$grid)*$grid]
+		set y [expr floor($y/$grid)*$grid]
+	}
+	switch -- $sel {
+		obj {    set goto [list $self new_object_edit]}
+		msg {    set goto [list $self new_object_edit]}
+		text {   set goto [list $self new_object_edit]}
+		default {set goto [list $self new_object_callback]}
+	}
+	netsend [concat [list .$self $sel $x $y] $args] $goto
+}
+
+def Canvas new_wire_callback {wire} {}
+
+def Canvas new_object_callback {obj} {
+	$self add_to_obj_history $obj
+	set @keynav_last_obj $obj
+	$self selection+= $obj
+	if {$@keynav} {$self update_Active $obj}
+}
+
+def Canvas new_object_copyselect {obj} {
+	$self selection+= $obj
+	#set @action "move"
+	#$self click_on_object $obj 0
+}
+
+def Canvas new_wire_select {wire} {$self selection_wire+= $wire}
+
+def Canvas new_object_edit     {obj} {
+	if {[$obj class] == "NumBox"} {return}
+	$obj edit
+}
+
+def Canvas add_to_obj_history {obj} {
+	if {![[$obj class] <= ObjectBox]} {return}
+	obj_hist prepend [$obj text]
+}
+
+
+def Canvas insertxy {} {return [list $@insert_x $@insert_y]}
+
+def Canvas insert_object {} {$self do_insert_obj "none" "none"}
+
+def Canvas get_canvas {} {
+	if {![info exists @gop]} {
+		if {[info exists @subpatch]} {if {$@subpatch} {return [$self canvas]}}
+		if {[info exists @abs]} {if {$@abs} {return [$self canvas]}}
+		if {[winfo exists .$self.c]} {return $self}
+	}
+	#if {[info exists @subpatch]} {if {$@subpatch} {return [$self canvas]}}
+	return [super]
+}
+
+def Canvas get_topcanvas {} {
+	set canvas $@canvas
+	if {$@canvas == ""} {return $self}
+	while {[$canvas canvas] != ""} {set canvas [$canvas canvas]}
+	return $canvas
+}
+
+def Canvas do_insert_obj {x y} {
+	if {$x == "none" && $y == "none"} {
+		if {[$@wiresel size] != 1} {return}
+		set wire [$@wiresel values]
+		puts "insert object for wire $wire"
+		mset {from outlet to inlet} [$wire report]
+		set c [$self widget]
+		set iowidth [$self look iowidth]
+		mset {ox1 oy1 ox2 oy2} [lmap / [$c bbox ${from}o${outlet}] [$self zoom]]
+		mset {ix1 iy1 ix2 iy2} [lmap / [$c bbox   ${to}i${inlet} ] [$self zoom]]
+		set x1 [expr $ox1 + $iowidth/2]; set y1 [expr ($oy1+$oy2)/2]
+		set x2 [expr $ix1 + $iowidth/2]; set y2 [expr ($iy1+$iy2)/2]
+		set x [expr $x1 + ($x2-$x1)/2]
+		set y [expr $y1 + ($y2-$y1)/2]
+	}
+	netsend [list .$self obj $x $y] [list $self new_object_edit]
+	set @action insert
+}
+
+def Canvas new_object_insert_wire {obj} {
+	set wire [$self selection_wire]
+	$self selection_wire-= $wire
+	mset {from outlet to inlet} [$wire report]
+	$self disconnect [$wire connects]
+	set @keynav 0; $@active hide; set @keynav_tab_sel "object"
+	set from_idx [$@objects search $from]
+	set   to_idx [$@objects search $to]
+	set obj3_idx [$@objects search $obj]
+	$self connect [list $from_idx $outlet $obj3_idx 0] [list $self keynav_current=]
+	$self connect [list $obj3_idx 0 $to_idx $inlet]
+	$self action= none
+}
+
+def Canvas chain_object {} {
+	if {[$@objectsel size] != 1} {return}
+	set o [$@objectsel values]
+	mset {x1 y1 x2 y2} [$o bbox]
+	set grid [$self look grid_size]
+	if {[$self look snap_grid]} {set y [expr floor(($y2+$grid)/$grid)*$grid]} {set y [expr $y2+10]}
+	netsend [list .$self obj $x1 $y] [list $self new_object_edit]
+	set @action chain_obj
+}
+def Canvas new_object_chain_wire {obj} {
+	obj_hist prepend [$obj text]
+	set from_idx [$@objects search [lindex [$self selection] 0]]
+	$self deselect_all
+	set to_idx [$@objects search $obj]
+	$self connect [list $from_idx 0 $to_idx 0]
+	$self action= none
+	$self selection= $obj
+}
+
+def Canvas objects {} {return $@objects}
+#def Canvas wires {} {return $@wires}
+def Canvas selection        {} {$@objectsel values}
+def Canvas selection=       {objs} {$@objectsel clear; $self selection+= $objs}
+def Canvas selection+=      {objs} {foreach obj $objs {$@objectsel set [$obj index] $obj}}
+def Canvas selection-=      {objs} {foreach obj $objs {set k [$obj index]; if {[$@objectsel exists $k]} {$@objectsel unset $k}}}
+def Canvas selection_wire   {} {$@wiresel values}
+def Canvas selection_wire=  {objs} {$@wiresel clear; $self selection_wire+= $objs}
+def Canvas selection_wire+= {objs} {foreach obj $objs {$@wiresel set [$obj index] $obj}}
+def Canvas selection_wire-= {objs} {foreach obj $objs {set k [$obj index]; if {[  $@wiresel exists $k]} {  $@wiresel unset $k}}}
+
+def Canvas Object  {} {$self new_object obj}
+def Canvas Message {} {$self new_object msg}
+def Canvas Number  {} {$self new_object floatatom}
+def Canvas Symbol  {} {$self new_object symbolatom}
+def Canvas Comment {} {$self new_object text}
+
+#!@#$ these 9 should be harmonised with the class list instead of having special names
+def Canvas bng     {} {$self new_object obj bng}
+def Canvas tgl     {} {$self new_object obj tgl}
+def Canvas nbx     {} {$self new_object obj nbx}
+def Canvas vsl     {} {$self new_object obj vsl}
+def Canvas hsl     {} {$self new_object obj hsl}
+def Canvas vradio  {} {$self new_object obj vradio}
+def Canvas hradio  {} {$self new_object obj hradio}
+def Canvas vu      {} {$self new_object obj vu}
+def Canvas dropper {} {$self new_object obj dropper}
+def Canvas cnv     {} {$self new_object obj cnv}
+
+def Canvas Graph   {} {$self editmode= 1; netsend [list .x$self graph    ]}
+def Canvas Array   {} {$self editmode= 1; netsend [list .x$self menuarray]}
+
+def Canvas init_menus {} {
+    set name .$self
+    set m $name.m
+    menu $m
+    #removed Paths after send_message
+    foreach x {file edit find view put window help} {menu $m.$x -tearoff $::pd_tearoff}
+    $self populate_menu file {new_file open_file {} send_message {} close save save_as print {} abort_server quit}
+    $self populate_menu edit {undo redo {} cut copy paste duplicate select_all subpatcherize {} tidy_up {}}
+    $self populate_menu find {find find_again find_last_error}
+    $m.view add checkbutton -label [say visual_diff] -selectcolor grey0 -command [list $self visual_diff] \
+    	-accelerator [accel_munge "Ctrl+e"] -indicatoron 1
+    $self populate_menu view {get_elapsed {} reload redraw}
+    $self populate_menu put {Object Message Number Symbol Comment {} bng tgl nbx vsl hsl vradio hradio vu dropper cnv {} Graph Array}
+    $self populate_menu window {{}}
+    $m.edit add checkbutton -label [say edit_mode] -selectcolor grey0 -command [list $self editmodeswitch] \
+    	-accelerator [accel_munge "Ctrl+e"] -indicatoron 1
+    $m.edit   configure -postcommand "$self fix_edit_menu"
+    $m.window configure -postcommand "$self fix_window_menu"
+    foreach x {file edit view find put window help} {
+      if {$x=="help"} {
+	# help menu is in the wrong place in patch windows because it's taken from .mbar ???
+	$m add cascade -label [say $x] -menu .mbar.$x
+      } {
+	$m add cascade -label [say $x] -menu $m.$x
+      }
+    }
+}
+
+# corrects edit menu, enabling or disabling undo/redo
+# LATER also cut/copy/paste
+def Canvas fix_edit_menu {} {
+    set e .$self.m.edit
+    switch $::OS {osx {set i 0} default {set i 1}}
+    set t [say undo]
+    if {[$@history can_undo?]} {
+	$e entryconfigure $i -state normal   -label "$t [$@history next_undo_name]"
+    } else {
+	$e entryconfigure $i -state disabled -label "[say cannot] $t"
+    }
+    incr i
+    set t [say redo]
+    if {[$@history can_redo?]} {
+	$e entryconfigure $i -state normal   -label "$t [$@history next_redo_name]"
+    } else {
+	$e entryconfigure $i -state disabled -label "[say cannot] $t"
+    }
+}
+
+def Menuable fix_window_menu {} {
+    set menu $@menubar.window
+    $menu delete 0 end
+    foreach w $::window_list {$menu add command -label [wm title [$w window]] -command "$w raise"}
+#   {"parentwindow" {menu_windowparent} ""}
+}
+
+#-----------------------------------------------------------------------------------#
+#this just tells whether an object is part of the selection, that is, what usually makes objects turn blue.
+def Canvas selection_include? {member} {expr [$@objectsel search $member]>=0}
+
+def Canvas type {} {
+	if {$@subpatch && !$@gop} {return "sub"}
+	if {$@subpatch && $@gop} {return "gopsub"}
+	if {$@abs && !$@gop} {return "abs"}
+	if {$@abs && $@gop} {return "gopabs"}
+	if {!$@subpatch && !$@abs && !$@gop} {return "toplevel"}
+}
+
+def Canvas draw {} {
+	if {$@gop} {
+		if {[$self gop_check]} {$self all_changed}
+		#if the focus is not in the opened gop
+		if {[regexp {^.x[0-9a-f]{6,8}.c} [focus] f]} {
+			if {$@canvas != ""&& $f != [$self widget]} {super;return}
+		} elseif {$@canvas != "" && [focus] != [$self widget]} {super;return}
+	} elseif {$@subpatch || $@abs} {super}
+	if {!$@mapped} {return} else {if {![winfo exists [$self widget]]} {return}}
+	$self check_findbar
+	if {$@editmode} {set bg [$self look bgedit]} else {set bg [$self look bgrun]}
+	[$self widget] configure -background $bg
+	$self adjust_scrollbars
+	if {$@gop} {$self gop_rect}
+}
+
+def Canvas popup_properties {} {CanvasPropertiesDialog new $self}
+
+def Canvas gop_target {id} {
+	while {[$id canvas] != $self} {set id [$id canvas]}; return $id
+}
+
+#-----------------------------------------------------------------------------------#
+class_new Macro_Rect {View}
+
+def Macro_Rect init {} {super; $self data= 0 0 0 0 blue}
+
+def Macro_Rect data= {x1 y1 x2 y2 col} {
+	set @x1 $x1; set @y1 $y1
+	set @x2 $x2; set @y2 $y2
+	set @col $col
+}
+
+def Macro_Rect flash {x1 y1 x2 y2 col} {
+	$self data= $x1 $y1 $x2 $y2 $col
+	$self draw
+	after 500 $self erase
+}
+
+def Macro_Rect draw {} {
+	set @canvas [string range [focus] 1 [string first . [focus] 1]-1]
+	$self item MACRO rect [list $@x1 $@y1 $@x2 $@y2] -outline $@col
+}
+
+class_new Macro {EventHistory}
+def Macro init {} {
+	$::event_history subscribe $self
+	set @idx 0
+	set @state 0
+	set @list {}
+	set @ref_list {}
+	set @delay 200
+	set @offset_x 0
+	set @offset_y 0
+	set @rect [Macro_Rect new]
+}
+def Macro state= {val} {
+	set @state $val
+	if {$val} {
+		set @ref_list {}
+		set @list {}
+		post %s "start recording macro..."
+	} else {
+		post %s "end..."
+	}
+}
+def Macro state {} {return $@state}
+def Macro dump {} {set i 0; foreach step $@list {post %s "step $i -> $step"; incr i}}
+def Macro idx= {val} {set @idx $val}
+def Macro idx {} {return $@idx}
+def Macro delay {} {return $@delay}
+def Macro append_ref {mess} {lappend @ref_list $mess}
+def Macro ref_list {} {puts "$@ref_list";return $@ref_list}
+def Canvas ref_list {} {$::macro ref_list}
+
+
+def Macro notice {args} {
+	if {$@state} {
+		set mess [lindex $args 2]
+		switch [lindex $args 1] {
+			add {$self add $mess}
+			default {}
+		}
+	}
+}
+
+def Macro add {mess} {
+	mset {event widget x y mode k kval} $mess
+	if {[regexp {^Control_} $k]} {return}
+	if {[regexp {^Alt_} $k]} {return}
+	if {[regexp {^Shift_} $k]} {return}
+	if {$event == "KeyRelease"} {return}
+	if {$event == "ButtonRelease"} {lappend @list [lreplace $mess 0 0 "Motion"]}
+	if {$event == "KeyPress"} {lappend @list [lreplace $mess 0 0 "Motion"]}
+	if {$event == "ButtonPress"} {lappend @list [lreplace $mess 0 0 "Motion"]}
+	lappend @list $mess
+}
+
+def Macro test_playable {x y} {
+	mset {macro_width macro_height} [$self calc_size]
+	set c [string range [focus] 0 [string first . [focus] 1]+1]
+	set cwidth [winfo width $c]; set cheight [winfo height $c]
+	set cx1 [$c canvasx 0]; set cy1 [$c canvasy 0]
+	set cx2 [$c canvasx $cwidth]; set cy2 [$c canvasy $cheight]
+	set new_x [expr $x+$macro_width]; set new_y [expr $y+$macro_height]
+	$@rect flash $x $y $new_x $new_y blue
+	if {$new_x > $cx2 || $new_x < $cx1 || $new_y > $cy2 || $new_y < $cy1} {
+		puts "Can't playback Macro:: outside of canvas area"
+		return
+	} else {$self idx= 0; $self offset $x $y; $self play [$self delay]}
+
+}
+
+def Macro offset {new_x new_y} {
+	mset {event widget x y mode k kval} [lindex $@list 0]
+	set @offset_x [expr $new_x-$x]
+	set @offset_y [expr $new_y-$y]
+}
+
+def Macro play {delay} {
+	if {$@idx == [llength $@list]} {return}
+	#$self test_canvas_size
+	set i 0
+	set focus [string range [focus] 1 [string first . [focus] 2]-1]
+	set step [lindex $@list $@idx]
+	#puts "\t $step"
+	mset {event widget x y mode k kval} $step
+	switch $event {
+		#KeyRelease {set name [modekey $k $mode]}
+		KeyPress {set name [modekey $k $mode]}
+		ButtonPress {set name $event-$k}
+		ButtonRelease {set name $event-$k}
+		Motion {set name $event}
+		default {puts "Error: event $event should not have been here.."}
+	}
+	if {$@idx < [llength $@list]} {
+		#after $delay [list $self run $event $name $k [expr $X+$@offset_x] [expr $Y+$@offset_y] \
+		#		  [expr $x+$@offset_x] [expr $y+$@offset_y]]
+		after $delay [list $self run $event $name $k $x $y]
+	}
+}
+
+#this don't make sense when multiple window, and should be re implemeneted somehow
+def Macro calc_size {} {
+	set x1 66666; set x2 0
+	set y1 66666; set y2 0
+	foreach step $@list {
+		mset {event widget x y mode k kval} $step
+		set x1 [min $X $x1]; set x2 [max $x2 $X]
+		set y1 [min $Y $y1]; set y2 [max $y2 $Y]
+		
+	}
+	return [list [expr $x2-$x1] [expr $y2-$y1]]
+}
+
+def Macro test_canvas_size {} {
+	set c [string range [focus] 0 [string first . [focus] 1]+1]
+	set cwidth [winfo width $c]; set cheight [winfo height $c]
+	set cx1 [$c canvasx 0]; set cy1 [$c canvasy 0]
+	set cx2 [$c canvasx $cwidth]; set cy2 [$c canvasy $cheight]
+	mset {x1 y1 x2 y2} [$self calc_size]
+}
+
+def Macro run {event name k x y} {
+	set w [focus]
+	incr @idx
+	event generate $w <$name> -x $x -y $y
+	if {$event=="KeyPress"} {event generate $w <KeyRelease-$k> -x $x -y $y}
+	$self play $@delay
+}
+
+def Macro copy {} {
+	clipboard clear
+	selection clear
+	set i 0
+	foreach step $@list {
+		if {$i == [expr [llength $@list]-1]} {set comma ""} else {set comma ","}
+		mset {event widget x y mode k kval} $step
+		set mess [list $event $x $y $mode $k]
+		set t ${mess}$comma
+		switch $event {
+			KeyPress {clipboard append [lreplace $t 0 0 "key"]}
+			ButtonPress {clipboard append [lreplace $t 0 0 "click"]}
+			ButtonRelease {clipboard append [lreplace $t 0 0 "unclick"]}
+		}
+		incr i
+	}
+	selection handle -selection PRIMARY [focus] "$self getdata"
+	selection own -command lost -selection PRIMARY
+}
+
+def Macro getdata {offset maxchar} {
+	puts "clipboard ::: [clipboard get]"
+	return [string range [format %s [clipboard get]] $offset [expr {$offset+$maxChars}]]
+}
+
+def Macro reset {} {set @idx 0}
+
+set ::macro [Macro new]
+set ::macro_state 0
+
+def Canvas macro_toggle {} {if {![$::macro state]} {set ::macro_state 1} {$::macro state= 0; $::macro dump}}
+#def Canvas macro_play {} {puts ">> $@click_at <<"; $::macro idx= 0; $::macro play [$::macro delay]}
+def Canvas macro_play {} {
+	mset {x y} $@click_at
+	$::macro reset 
+	$::macro play [$::macro delay]
+	#$::macro test_playable $x $y
+}
+def Canvas keyevent {} {
+	focus [$self widget]
+	event generate [$self widget] <Control-Key-1>
+}
+
+def Canvas macro_copy {} {$::macro copy}
+
+#-----------------------------------------------------------------------------------#
+class_new TextBox {Box}
+
+def TextBox init {mess} {
+	super $mess
+	set @edit 0
+	set @x1 [lindex $mess 2]
+	set @y1 [lindex $mess 3]
+	set @text [$self remove_braces [join [lrange $mess 4 end]]]
+	set @multi 0
+	set @max_width 40
+	# @textoffset is for offseting the text item/widget, ie, ObjectBox vs NumBox
+	switch [$self class] {
+		NumBox {set @textoffset [list 10 2]}
+		default {set @textoffset [list 2 2]}
+	}
+}
+
+def TextBox text= {text} {set @text [$self remove_braces [join $text]]}
+def TextBox text {} {return $@text}
+def TextBox filter_text {{for_edit 0}} {return $@text}
+
+def TextBox draw {} {
+	if {[$self class] == "Canvas"} {if {$@text == "graph"} {$self update_size; super; return}}
+	# "TEXT" is the text label while "text" is the the input text field tk widget.
+	# the text should be drawn before, so that update_size works at the right time.
+	mset {x1 y1} [$self xy]
+	set z [$@canvas zoom]
+	if {$@edit} {
+		$self draw_edit
+	} else {
+		set fw [font measure [$self look font] 0]
+		set text [$self filter_text]
+		if {$::leet} {set text [string map -nocase {a 4 e 3 t 7 s 5 i 1 o 0 g 9} $text]}
+		$self item TEXT text [l+ $@textoffset [$self xy]] \
+		    -font [$self look  font] -text $text \
+		    -fill [$self look fg] -anchor nw -width [expr ($fw*$@max_width)-1]
+		# set width with -1 because text item seem to be inclusive at wrap point
+		# where as the text widget is exclusive
+	}
+	$self update_size
+	super
+}
+
+def TextBox edit {} {
+	if {$@edit} {return}; set @edit 1; $self changed edit
+	if {[[$self class] <= AtomBox]} {set @clear 1}
+}
+
+def TextBox new_bind {} {
+	set t [$self cwidget].${self}text
+	bind $t <Key>            "$self key_input %W %x %y %K %A 0"
+	bind $t <Control-Return> "$self key_input %W %x %y 10 %A 0"
+	bind $t <Control-v>      "$self paste_resize"
+	bind $t <Return>         "$self unedit"
+	bind $t <Escape>         "$self unedit 0"
+	bind $t <Up> "$self scroll_history +1"
+	bind $t <Down> "$self scroll_history -1"
+	bind $t <Control-p> "$self scroll_history +1"
+	bind $t <Control-n> "$self scroll_history -1"	
+	bind $t <Alt-BackSpace> "$self clear"
+}
+
+def TextBox draw_edit {} {
+	set c [$self cwidget]
+	switch $::tcl_platform(os) {
+		Linux {$c configure -cursor crosshair}
+		#need to find equivalent names for other os
+	}
+	if {[lsearch [$@canvas selection] $self] < 0} {$@canvas selection+= $self}
+	set t $c.${self}text
+	if {[winfo exists $t]} {return}
+	set @edit 1
+	set @tab_repeats 0
+	obj_hist histi= 0
+	set @selected? 1
+	set z [$@canvas zoom]
+	set font_height [font metrics [$self look font] -linespace]
+	if {[$c bbox ${self}TEXT] != ""} {
+		mset {ix1 iy1 ix2 iy2} [lmap / [$c bbox ${self}TEXT] $z]
+		if {($iy2-$iy1)/$z > $font_height} {set @multi 1}
+	} else {
+		set ix1 0; set iy1 0
+		set ix2 [font measure [$self look font] 0]
+		set iy2 [font metrics [$self look font] -linespace]
+	}
+	$c delete ${self}TEXT
+	set font_str [$self look font]
+	set new_size [format %.0f [expr [lindex $font_str 1]*$z]]
+	set font_str [lreplace $font_str 1 1 $new_size]
+	foreach char [split $@text ""] {lappend l [scan $char %c]}
+	mset {width height} [$self get_size [expr $ix2-$ix1] [expr $iy2-$iy1]]
+	set insertbg [$self look fg]; set fg [$self look fg]
+	if {[[$self class] <= AtomBox]} {set fg "red"; set insertbg [$self look bgedit]}
+	text $t -width $width -height $height -relief flat -bg [$self look bgedit] -borderwidth 0 \
+		-highlightthickness 0 -font $font_str -fg $fg -insertbackground $insertbg -wrap word
+	$self new_bind
+	$@canvas focus= $self
+	$self item text window [l+ [lmap / $@textoffset $z] [$self xy]] -window $t -anchor nw -tags "${self}text $self text"
+	$t insert 1.0 $@text
+	$t configure -pady 0 -padx 0
+	$self resize
+	focus $t
+}
+
+def TextBox resize {} {
+	if {[[$self class] <= AtomBox]} {return}
+	set c [$self cwidget]
+	set t $c.${self}text
+	#set z [$@canvas zoom]
+	set pix_height [$t count -update -ypixels 1.0 end]
+	set pix_width [font measure [$self look font] [$t get 1.0 end]]
+	mset {width height} [$self get_size $pix_width $pix_height]
+	$t configure -width [min $width $@max_width] -height $height -wrap word
+}
+
+def TextBox get_size {w h} {
+	set c [$self cwidget]
+	set t $c.${self}text
+	set pix_height $h
+	set pix_width $w
+	set char_width [font measure [$self look font] 0]
+	set line_height [font metrics [$self look font] -linespace]
+	set round_chars [expr int(ceil($pix_width/$char_width.0))]
+	if {$round_chars < $@max_width && !$@multi} {
+		set round_lines 1
+	} else {
+		set @multi 1
+		set round_chars $@max_width
+		set round_lines [expr int(ceil($pix_height/$line_height))]
+	}
+	return [list $round_chars $round_lines]
+}
+
+def TextBox key_input {widget x y key iso shift} {
+	after 0 "$self after_key $widget"
+	set c [$@canvas widget]
+	set t $c.${self}text
+	if {[[$self class] <= AtomBox]} {if {$@clear} {$t delete 1.0 1.end; set @clear 0}}
+	switch -- $key {
+		Tab {
+			if {[$self class] == "ObjectBox"} {
+				$self propose_completions; $widget configure -state disabled
+			}
+		}
+		10 {$t configure -height [expr [lindex [$t configure -height] 4] + 1]}
+	}
+}
+
+def TextBox after_key {widget} {
+	$widget configure -state normal; # for in case there is completion box
+	$self resize
+	$self changed
+}
+
+def TextBox paste_resize {} {
+	if {[[$self class] <= AtomBox]} {return}
+	set c [$self cwidget]
+	set t $c.${self}text
+	set fixed [font metrics [$self look font] -fixed]
+	set text [clipboard get]
+	if {$fixed} {
+		set width [string length $text]
+	} else {
+		set textpix [font measure [$self look font] $text]
+		set fwidth [font measure [$self look font] 0]
+		set width [expr (($textpix+$fwidth-1)/$fwidth)+1]
+	}
+	set maxwidth 40
+        mset {y1 y2} [$t yview]
+        if {$width < $maxwidth} {set height 1} {set height [expr ceil($width/$maxwidth.0)]}
+	$t configure -width [min $width $maxwidth] -height $height -wrap word
+	after 0 [list $t mark set insert 1.end]
+	$t mark set insert 1.0
+	$self update_size
+	$self changed
+}
+
+def TextBox scroll_history {incr} {
+	if {[[$self class] <= MessageBox]} {return}
+	set c [$self cwidget]
+	set t $c.${self}text
+	if {![obj_hist histi]} {obj_hist set_hist 0 [$t get 1.0 1.end]}
+	$t delete 1.0 1.end
+	set text [obj_hist traverse $incr]
+	$t insert 1.0 $text
+	$t configure -width [string length $text]
+	$self update_size
+	after 0 $self changed
+	
+}
+
+def TextBox clear {} {
+	set c [$self cwidget]
+	set t $c.${self}text
+	$t delete 1.0 1.end
+
+}
+
+def TextBox text {} {return $@text}
+
+def TextBox update_size {} {
+	if {[info exists @gop]} {if {$@gop} {mset [list @xs @ys] $@pixsize; return}}
+	if {$@canvas == ""} {puts "update_size: this textbox has no canvas, try again later"; return}
+	set c [$self cwidget]
+	set t_widget $c.${self}text
+	set t_item $c.${self}TEXT
+	set w2 0; set h2 0
+	set xpad 2; set ypad 3
+	set z [$@canvas zoom]
+	if {[winfo exists $t_widget]} {
+		set textwidth [expr ([winfo reqwidth $t_widget]+$xpad)/$z]
+		set height [expr ([winfo reqheight $t_widget]+$ypad)/$z]
+	} else {
+		mset {x1 y1 x2 y2} [[[$self canvas] widget] bbox ${self}TEXT]
+		set textwidth [expr ($x2-$x1+$xpad)/$z]
+		set height [expr ($y2-$y1+$ypad)/$z]
+	}
+	set iowidth [$self look iowidth]
+	set topwidth    [expr {(2* $@ninlets-1)*$iowidth}]
+	set bottomwidth [expr {(2*$@noutlets-1)*$iowidth}]
+	set @xs [max [$self look minobjwidth] [max $bottomwidth [max $topwidth $textwidth]]]
+	set @ys $height
+}
+
+#-----------------------------------------------------------------------------------
+
+class_new ObjectBox {TextBox}
+
+def ObjectBox init {mess} {
+	super $mess
+	set @valid 0 ;# only ObjectBox needs a @valid. (removed all others)
+	set @ninlets 0
+	set @noutlets 0
+	set @pdclass ""
+}
+
+def ObjectBox valid= {v}    {set @valid $v}
+def ObjectBox valid  {} {return $@valid}
+def Canvas objectsel {} {return $@objectsel}
+def Canvas   wiresel {} {return   $@wiresel}
+
+def ObjectBox draw_box {} {
+	super
+	set xya [$self bbox]
+	mset {x1 y1 x2 y2} $xya
+	#set xyb [l+ [list $x2 $y1 $x1 $y1 $x1 $y2] [list -1 +1 +1 +1 +1 -1]]
+	#set xyc [l+ [list $x2 $y1 $x2 $y2 $x1 $y2] [list -1 +1 -1 -1 +1 -1]]
+        if {[$self selected?]} {set fg [$self look selectframe]} {set fg [$self look frame3]}
+	if {$@valid} {
+		$self item BASE rectangle $xya -fill [$self look bg] -outline $fg -width 1
+	} else {
+		$self item BASE rectangle $xya -fill [$self look bg] -outline $fg -width 1 -dash {3 3}
+	}
+	#$self item BASE1 line      $xyb -fill [$self look frame1] -width 1
+	#$self item BASE2 line      $xyc -fill [$self look frame2] -width 1
+	#[$@canvas widget] lower ${self}BASE ${self}TEXT
+	[[$self get_canvas] widget] lower ${self}BASE ${self}TEXT
+	#[[$self get_canvas] widget] lower ${self}BASE
+}
+
+def ObjectBox draw {} {super; $self draw_io}
+
+# this is called from the GUI; text= is reserved for server.
+def TextBox setto {text} {
+	[$@canvas history] add [list $self setto $@text]
+	[$@canvas widget] configure -cursor {}
+	set @text $text
+	set l {}
+	foreach char [split $@text ""] {lappend l [scan $char %c]}
+	$@canvas selection-= [list $self]
+	switch [$@canvas action] {
+		insert        {set goto [list $@canvas new_object_insert_wire]}
+		chain_obj     {set goto [list $@canvas new_object_chain_wire]}
+		subpatcherize {set goto [list $@canvas new_object_subpatcherize_redraw]}
+		default       {set goto [list $@canvas new_object_callback]}
+	}
+	netsend [concat [list .$@canvas text_setto $self] $l] $goto
+}
+
+def TextBox unedit {{accept 1}} {
+	if {!$@edit} {return}
+	set @edit 0
+	$self changed edit
+	set c [[$self get_canvas] widget]
+	set t $c.${self}text
+	if {$accept} {$self setto [$t get 1.0 "end - 1 chars"]}
+	after 1 "destroy $t"
+	if {[winfo exists .completion]} {$@action cancel}
+	focus $c
+	$@canvas focus= ""
+}
+
+#-----------------------------------------------------------------------------------#
+def Canvas name {} {return $@name}
+def Canvas folder {} {return $@folder}
+def Canvas name=   {name}    {if {!$@mapped} {return}; set @name   $name  ; $self update_title}
+def Canvas folder= {folder}  {if {!$@mapped} {return}; set @folder $folder; $self update_title}
+
+def Canvas make_title {} {
+	if {!$@mapped} {return}
+	if {$@subpatch} {
+		if {$@canvas == "" || 0==[string compare $@canvas $self]} {
+			set t "(uh)"
+		} else {
+			set t [$@canvas make_title]
+		}
+		set t "subpatch '$@name' of $t"
+	} else {
+		#set t "$@name in $@folder"
+		set t "$@name"
+	}
+	if {[$self modified?]} {append t "(*)"}
+	return $t
+}
+
+def Canvas update_title {} {
+	if {[winfo exists .$self]} {wm title .$self [$self make_title]}
+}
+
+# UNIMPLEMENTED: this should indicate whether the patch in pd is different from the last saved patch
+def Canvas modified? {} {return 1}
+
+def Canvas mapped {} {return $@mapped}
+def Canvas mapped= {v} {set @mapped $v}
+
+def Canvas havewindow= {flag} {
+	set was [winfo exists .$self]
+	if {$flag && !$was} {$self init_window; $self redraw}
+	#if {$flag && $was && [$self gop]} {$self redraw}
+	if {$flag && $was} {$self raise}
+	if {!$flag && $was} {$self delete_window}
+}
+
+def Canvas visibles+= {child} {
+	if {[lsearch $@visibles $child]  < 0} {lappend @visibles $child; $self changed visibles}
+}
+def Canvas visibles-= {child} {
+	if {[lsearch $@visibles $child] >= 0} {set @visibles [lwithout $@visibles $child]; $self changed visibles}
+}
+
+def Canvas visibles {} {return $@visibles}
+
+def Canvas all_changed {} {
+	foreach x $@visibles {
+		if {[$x class] == "Canvas"} {
+			if {$@gop} {$x all_changed}
+		}
+		$x changed
+	}
+}
+
+# this is a shim between the client's new-style indices and the server's remaining old-style indices
+proc dex {h k} {lsearch [lsort -integer [$h keys]] $k}
+
+# for undo; calls the server
+def Canvas ins {i constructor} {
+	set parts [pd_mess_split $constructor]
+	set last [lindex $parts end]
+	set parts [lrange $parts 0 end-1]
+	foreach part $parts {netsend $part}
+	netsend [concat [list .$self object_insert [dex $@objects $i]] $last] ;# bork bork bork
+	$@history add [list $self del $i]
+}
+
+def Canvas del {i} {
+	set o [$@objects get $i]
+	#this keynav should be better sorted out
+	if {$o == $@keynav_current || $o == $@keynav_last_obj} {
+		set @keynav_current 0
+		set @keynav_last_obj 0
+	}
+	# this "if" might not be necessary... try deconstruct_to for everything.
+	if {[$o class] != "Canvas"} {
+		$@history add [list $self ins $i [$o deconstruct]]
+	} else {
+		set meuh [Clipboard2 new]
+		$o deconstruct_to $meuh
+		$@history add [list $self ins $i [$meuh value]]
+		$meuh delete
+	}
+	netsend [list .$self object_delete $o]
+}
+
+def Canvas wires {} {return $@wires}
+
+def Canvas delete_selection {} {
+	if {![$@objectsel size] && ![$@wiresel size]} {return}
+	#this keynav should be better sorted out
+	if {$@keynav} {
+		set @keynav 0
+		switch [$@keynav_current class] {
+			Wire    {set @keynav_last_wire 0}
+			default {set @keynav_last_obj  0}
+		}
+		set @keynav_current 0
+		$@active hide
+	}
+	set del_wire {}
+	foreach obj [$@objectsel values] {
+		foreach wire [$obj wires2] {
+			if {[$@wires search $wire] != -1 && [lsearch $del_wire $wire] < 0} {
+				$self disconnect [$wire connects]
+				lappend del_wire $wire
+			}
+		}
+		$self del [$@objects search $obj]
+	}
+	foreach x [$@wiresel values] {
+		if {[$@wires search $x] != -1 && [lsearch $del_wire $x] < 0} {
+			$self disconnect [$x connects]
+		}
+	}
+	$@objectsel clear
+	$@wiresel   clear
+}
+
+def View position= {xy1} {mset [list @x1 @y1] $xy1; $self changed x1 y1}
+def View set_orig_xy {x y} {set @orig_x $x; set @orig_y $y}
+
+def Canvas motion_wrap {x y f} {
+	set c [$self widget]
+	set x [expr [$c canvasx $x]/$@zoom]
+	set y [expr [$c canvasy $y]/$@zoom]
+	lappend @motion_queue [list $x $y $f]
+	#$self motion $x $y $f [$self identify_target $x $y $f]
+}
+
+def Canvas motion_update {} {
+	if {[llength $@motion_queue]} {
+		mset {x y f} [lindex $@motion_queue end]; set @motion_queue {}
+		$self motion $x $y $f [$self identify_target $x $y $f]
+	}
+	set @motion_after_id [after 50 "$self motion_update"]
+}
+
+def Canvas click_wrap {x y b f} {
+	set c [$self widget]
+	set x [expr [$c canvasx $x]/$@zoom]
+	set y [expr [$c canvasy $y]/$@zoom]
+	set f [expr 1<<($b+7)|$f]
+	$self click $x $y $f [$self identify_target $x $y $f]
+}
+def Canvas unclick_wrap {x y b f} {
+	set c [$self widget]
+	set x [expr [$c canvasx $x]/$@zoom]
+	set y [expr [$c canvasy $y]/$@zoom]
+	set f [expr 1<<($b+7)|$f]
+	$self unclick $x $y $f [$self identify_target $x $y $f]
+}
+def Canvas key_wrap {x y key iso shift} {
+	set c [$self widget]
+	$self key [expr [$c canvasx $x]/$@zoom] [expr [$c canvasy $y]/$@zoom] $key $iso $shift
+}
+def Canvas keyup_wrap {x y key iso shift} {
+	set c [$self widget]
+	$self keyup [expr [$c canvasx $x]/$@zoom] [expr [$c canvasy $y]/$@zoom] $key $iso $shift
+}
+
+proc lsearch_minimum {l} {
+	set i 0
+	set j 0
+	set min [lindex $l 0]
+	foreach o $l {
+		if {$o < $min} {set i $j; set min $o}
+		incr j
+	}
+	return $i
+}
+
+def Canvas quadrant {du dv array} {
+	if {$@keynav_current == 0} {set @keynav_current [$@objects get [lindex [$@objects keys] 0]]}
+	set foo {}
+	set bar {}
+	set pos [$@keynav_current xy]
+	foreach o $array {
+		mset {x y} [l- $pos [$o xy]]
+		set u [expr $x+$y]
+		set v [expr $x-$y]
+		if {$u*$du>0 && $v*$dv>0} {lappend foo $o; lappend bar [distance $pos [$o xy]]}
+	}
+	if {![llength $bar]} {return $@keynav_current}
+	set best [lindex $foo [lsearch_minimum $bar]]
+	return $best
+}
+
+def Canvas motion {x y f target} {
+	#modes_callback $self "motion" $x $y $f $target
+	set c [$self widget]
+	$self motion_checkhairtip $target $x $y
+	eval $@dehighlight
+	set @dehighlight {}
+	set oldpos $@curpos
+	set @curpos [list $x $y]
+	# detects if the focus is not on the canvas itself in run mode, ie. numbox
+	if {!$@editmode & [$self focus] != $self & [$self focus] != ""} {
+		[$self focus] motion $x $y $f $target
+	}
+	mset {type id detail} $target
+	switch $@action {
+		edit {$self motion_edit $x $y $f}
+		insert {}
+		chain_obj {}
+		imove      {$self motion_imove $oldpos $x $y; return}
+		mouse_copy {$self motion_move  $oldpos $x $y; return}
+		move       {$self motion_move  $oldpos $x $y; return}
+		none {}
+		default {$@action motion $x $y $f $target}
+	}
+	if {$@editmode} {$self motion_iohilite2 $x $y $f}
+	if {$id == ""} {return}
+}
+
+proc remainder {val val2} {
+	if {[expr {abs($val)}]} {return [expr {(abs($val)%$val2)*($val/abs($val))}]} else {return 0}
+}
+
+def Canvas motion_move {oldpos x y} {
+	mset {ox oy} $oldpos
+	if {$@keynav} {$@active draw}
+	foreach obj [$@objectsel values] {
+		#if {[[$obj class] <= Box]} {
+			if {[$self look snap_grid]} {
+				set grid [$self look grid_size]
+				set ax  [expr {(int($x)/$grid)*$grid}]
+				set ay  [expr {(int($y)/$grid)*$grid}]
+				set oax [expr {(int($ox)/$grid)*$grid}]
+				set oay [expr {(int($oy)/$grid)*$grid}]
+				mset {x1 y1} [$obj xy]
+				if {![expr {($ax-$oax)%$grid}]} {
+					set xoff [remainder [expr {int($x1-$ax)}] $grid]
+				} else {set xoff 0}
+				if {![expr {($ay-$oay)%$grid}]} {
+					set yoff [remainder [expr {int($y1-$ay)}] $grid]
+				} else {set yoff 0}
+				$obj move [expr ($ax-$oax)-$xoff] [expr ($ay-$oay)-$yoff]
+			} else {
+				$obj move [expr {$x-$ox}] [expr {$y-$oy}]
+			}
+		#} else {
+		#	puts "Canvas motion warning: trying to move non-Box explicitly"
+		#}
+	}
+}
+
+def Canvas motion_imove {oldpos x y} {
+	mset {ox oy} $oldpos
+	if {$@keynav} {$@active draw}
+	if {[$@objectsel size] == 1} {
+		set obj [$@objectsel values]
+		set  in_objs $obj
+		set out_objs $obj
+	} else {
+		if {![llength $@keynav_iosel_i] || ![llength $@keynav_iosel_o]} {
+			return
+		} else {
+			set obj [lindex $@keynav_iosel_i 0]
+			set  in_objs $@keynav_iosel_i
+			set out_objs $@keynav_iosel_o
+		}
+	}
+	if {[[$obj class] <= Box]} {
+		if {[$obj class] == "Canvas"} {
+			if {[$obj gop]} {[$self widget] raise [list $obj [$obj visibles]]}
+		} else {
+			[$self widget] raise $obj
+		}
+		mset {type id detail} [$self identify_target $x $y 0]
+		if {$type == "wire"} {
+			mset {from outlet to inlet} [$id report]
+			$self disconnect [$id connects]
+			set from_idx [$@objects search $from]
+			set   to_idx [$@objects search $to]
+			foreach obj $in_objs {
+				set obj3_idx [$@objects search $obj]
+				if {![llength [$obj ioselect]]} {set port 0} else {set port [lindex [$obj ioselect] 0]}
+				set w1 [list $from_idx $outlet $obj3_idx $port]
+				if {[$@wires search $w1]<0} {$self connect $w1}
+			}
+			foreach obj $out_objs {
+				set obj3_idx [$@objects search $obj]
+				if {![llength [$obj ioselect]]} {set port 0} else {set port [lindex [$obj ioselect] 0]}
+				set w2 [list $obj3_idx $port $to_idx $inlet]
+				if {[$@wires search $w2]<0} {$self connect $w2}
+			}
+			set @action move
+		}
+		foreach obj [$@objectsel values] {$obj move [expr $x-$ox] [expr $y-$oy]}
+	} else {
+		puts "Canvas motion warning: trying to move non-Box explicitly"
+	}
+}
+
+def Canvas motion_edit {x y f} {
+	if {[distance [list $x $y] $@click_at] > 5} {
+		foreach obj [$@objectsel values] {
+			if {[[$obj class] <= Box]} {
+				$obj backupxy= [$obj xy]
+			} else {
+				puts "Canvas motion warning: trying to backup coordinates of non-Box"
+			}
+		}
+		if {$f == 9} {set @action imove} else {set @action move; $self motion_move $@click_at $x $y}
+		mset {ox oy} $@click_at
+	}
+}
+
+def Canvas motion_checkhairtip {target x y} {
+	global tooltip
+	if {[$self look hairstate] && $@editmode} {
+		$@crosshair data= $x $y $target
+		$@crosshair draw
+	} else {
+		$@crosshair erase
+	}
+	if {[$self look tooltip]} {
+		if {$tooltip ne "" && ![$tooltip iserror] && [expr [distance [$tooltip curpos] [list $x $y]] > 10]} {
+			$tooltip delete
+			set tooltip ""
+		}
+	}
+}
+
+def Canvas motion_iohilite2 {x y f} {
+	set c [$self widget]
+	set io [$self identify_closestio $x $y $f]
+	if {$io<0} {set @iohilite [list -1 0 0 0 0]; return}
+	foreach item {i o} {
+		set type_idx [string first $item $io]
+		set type [string index $io $type_idx]
+		set port [string range $io [expr $type_idx+1] end]
+		set object [string range $io 0 [expr $type_idx-1]]
+		if {$type_idx >= 0} {break}
+	}
+	mset {iox ioy} [lmap / [rect_centre [$c bbox $io]] $@zoom]
+	set @iohilite [list $object $iox $ioy $type $port]
+	$object hilite_io $type $iox $ioy
+	set @dehighlight [list $c delete ${io}b]
+}
+
+def Canvas iohilite {} {return $@iohilite}
+
+def Canvas motion_iohilite {target x y} {
+	set c [$self widget]
+	mset {type id detail} $target
+	if {[llength $@keynav_iosel_i] || [llength $@keynav_iosel_o]} {return}
+	if {$@editmode && [$id canvas] == $self} {
+		switch $type {
+			inlet  {set io i}
+			outlet {set io o}
+			default {return}
+		}
+		set port [$id hilite_io $io $x $y]
+		set @dehighlight [list $c delete ${id}$io${port}b]
+	}
+}
+
+#-----------------------------------------------------------------------------------#
+# returns one of those five things:
+#   object $id         : the  body of an object
+#    inlet $id  $inlet : an  inlet of an object
+#   outlet $id $outlet : an outlet of an object
+#     wire $id         : a wire
+#    label $id         : a label
+#  nothing             : nothing
+def Canvas identify_target {x y f} {
+	set c [$self widget]
+	set cx [expr $x*$@zoom]
+	set cy [expr $y*$@zoom]
+	set stack [$c find overlapping [expr $cx-2] [expr $cy-2] [expr $cx+2] [expr $cy+2]]
+	# reversing the stack is necessary for some things
+	# not reversing the stack is also necessary for some other things
+	# we have to figure out something.
+	set stack [lreverse $stack]
+	set target ""
+	foreach tag $stack {set target [$self target $x $y $f $tag]; if {[llength $target] > 1} {break}}
+	if {[llength $target] > 1} {return $target} {return [list "nothing"]}
+}
+
+def Canvas target {x y f tag} {
+	set c [$self widget]
+	set cx [expr $x*$@zoom]
+	set cy [expr $y*$@zoom]
+	set tags [$c gettags $tag]
+	if {[regexp {^[xo][0-9a-f]{6,8}} $tags id]} {
+		# prior to Aug 15th, Wires had lower priority as all objects together
+		# now it's same priority, so just stacking order (and it's prolly wrong)
+		if {[$id classtags] == ""} {return [list "nothing"]}
+		set class [$id class]
+		if {[$self == $id]} {continue}
+		if {[$class <= Wire]} {if {$@action != "imove"} {return [list "wire" $id]}}
+		if {[$class <= Box]} {
+			if {$@action == "imove"} {
+				foreach tag $stack {
+					set tags2 [$c gettags $tag]
+					if {[regexp {^[xo][0-9a-f]{6,8}} $tags2 id2]} {
+						set class [$id2 class]
+						if {[$class == Wire]} {return [list "wire" $id2]}
+					}
+				}
+			}
+			mset {x1 y1 x2 y2} [$id bbox]
+			if {[regexp {^x[0-9a-f]{6,8}LABEL} $tags label]} {
+				if {$x>$x1 && $x<$x2 && $y>$y1 && $y<$y2} {
+					return [list "object" $id]
+				} else {
+					return [list "label" $id]
+				}
+			}
+			set outs [$id noutlets]
+			set  ins [$id  ninlets]
+			if {$y>=$y2-6 && $outs} {
+				set val [expr int(($x-$x1)*$outs/($x2-$x1))]
+				if {$val == $outs} {set val [expr $val-1]}
+				return [list "outlet" $id $val]
+			}
+			if {$y< $y1+2 &&  $ins} {
+				set val [expr int(($x-$x1)* $ins/($x2-$x1))]
+				if {$val == $ins} {set val [expr $val-1]}
+				return [list  "inlet" $id $val]
+			}
+			return [list "object" $id]
+		}
+		#puts "skipped a $class"
+	}
+}
+
+def Canvas identify_closestio {x y f} {
+	set c [$self widget]
+	set cx [expr {$x*$@zoom}]
+	set cy [expr {$y*$@zoom}]
+	set sense [$self pointer_sense]
+	set stack [$c find overlapping [expr {$cx-$sense}] [expr {$cy-$sense}]\
+		                       [expr {$cx+$sense}] [expr {$cy+$sense}]]
+	set stack [lreverse $stack]
+	set ios {}
+	set objs {}
+	foreach tag $stack {
+		set tags [$c gettags $tag]
+		if {[regexp {^[x][0-9a-f]{6,8}[oi][0-9]{1,3}} $tags io]} {
+			foreach item {i o} {
+				set type_idx [string first $item $io]
+				set object [string range $io 0 [expr $type_idx-1]]
+				if {$type_idx >= 0} {break}
+			}
+			if {[$object canvas] == $self} {lappend ios $io}
+		}
+	}
+	if {![llength $ios]} {return -1}
+	set mindist 66666
+	set idx 0; set i 0
+	foreach io $ios {
+		set point2 [rect_centre [$c bbox $io]]
+		set point1 [list $x $y]
+		set dist [distance $point2 $point1]
+		if {$dist < $mindist} {set mindist $dist; set idx $i}
+		incr i
+	}
+	return [lindex $ios $idx]
+}
+def Canvas pointer_sense {} {return [$self look pointer_sense]}
+def Canvas pointer_sense= {sense} {
+	set ::look(Canvas:pointer_sense) $sense
+	mset {x y} $@curpos
+	$@sense flash $x $y $sense "red"
+}
+
+#-----------------------------------------------------------------------------------#
+class_new StatusBar {View} ;# no, using View is wrong here. View is for tk canvas item collections.
+
+def StatusBar widget {} {return .$@canvas.stat}
+
+def StatusBar addw {a b text args} {
+	set f [$self widget]
+	if {$text!=""} {
+		eval [concat [list pack [label $f.${a}_l -text $text -font {helvetica -10} -pady 0] -side left] $args]
+	}
+	label $f.$a -width $b -font {helvetica -10} -background #cccccc -foreground black -anchor w -pady 0
+	pack $f.$a -side left
+}
+
+def StatusBar init {canvas} {
+	super
+	set @canvas $canvas
+	set f [$self widget]
+	frame $f -border 1 -relief ridge
+	$self addw px     4 ""
+	$self addw py     4 ""
+	$self addw what   28 " " -fill x -expand yes
+	$self addw action 12  " Action: "
+	$self addw sel    3  " Sel: "
+	$self addw focus  10 " Focus: "
+}
+
+def Canvas statusbar_draw {x y} {$@statusbar draw $x $y}
+def Canvas action {} {return $@action}
+def Canvas action= {action} {set @action $action}
+def Canvas zoom {} {return $@zoom}
+
+def StatusBar draw {x y} {
+    if {$x == "??"} {return}
+    set c [$@canvas widget]
+    set f [$self widget]
+    set zoom [$@canvas zoom]
+    set x [expr [$c canvasx $x]/$zoom]
+    set y [expr [$c canvasy $y]/$zoom]
+    #set tags [$c gettags [lindex [$c find overlapping [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2]] end]]
+    set target [$@canvas identify_target $x $y -1]
+    mset {type id detail} $target
+    set t $target
+    switch -- $type {
+      object {
+	if {[info exists _($id:pdclass)]} {set class $_($id:pdclass)} {set class unknown}
+	append t " \[$class\]"
+      }
+    }
+    set action [$@canvas action]
+    if {[regexp ^o $action]} {set action [$action class]}
+    if {[string length [$@canvas focus]]} {set t "focus: [$@canvas focus]"}
+    $f.px     configure -text [format "%4d" [expr round($x)]]
+    $f.py     configure -text [format "%4d" [expr round($y)]]
+    $f.what   configure -text $t
+    $f.action configure -text $action
+    $f.sel    configure -text [llength [$@canvas selection]]
+    $f.focus  configure -text [$@canvas focus]
+}
+
+#-----------------------------------------------------------------------------------#
+class_new FindModel {Thing}
+
+def FindModel init {canvas} {
+	set @orig_canvas $canvas
+	set @find_string ""
+	set @next_canvases $canvas
+	set @last_canvas 0
+	set @result ""
+	set @results {}
+	set @views {}
+	set @recursive 1
+	set @info ""
+}
+
+def FindModel reinit {} {
+	set @next_canvases $@orig_canvas
+	set @last_canvas 0
+	set @result ""
+	set @results {}
+	$self remove_info
+}
+def FindModel remove_info {} {
+	foreach view $@views {
+		set f [$view widget]
+		destroy $f.info_l; destroy $f.info
+	}
+}
+def FindModel delete {} {foreach view $@views {destroy [$view widget]}; super}
+
+def FindModel find_string= {s} {set @find_string $s}
+def FindModel find_string {} {return $@find_string}
+def FindModel result= {s} {
+	$@orig_canvas deselect_all
+	$@orig_canvas selection= $s
+	set @result $s
+}
+def FindModel result {} {return $@result}
+def FindModel views+ {view} {lappend @views $view}
+def FindModel views {} {return $@views}
+def FindModel end? {} {return $@end}
+def FindModel end= {v} {set @end 0}
+
+def FindModel search_recursive {} {
+	if {![llength $@next_canvases]} {$self end; return}
+        if {[llength $@results]} {$self result= [lindex $@results 0]; set @results [lreplace $@results 0 0];return}
+	while {$@last_canvas < [llength $@next_canvases]} {
+		set canvas [lindex $@next_canvases $@last_canvas]
+		if {[$self cache_results $canvas]} {
+			if {![winfo exists [$canvas widget]]} {$canvas popup_open} else {focus [$canvas widget]}
+			$self result= [lindex $@results 0]
+			set @results [lreplace $@results 0 0]
+			incr @last_canvas
+			return
+		} else {
+			incr @last_canvas
+			$self search_recursive
+			return
+		}
+	}
+	set old_canvases $@next_canvases
+	set @next_canvases {}
+	if {$@recursive} {
+		foreach canvas $old_canvases {foreach x [$canvas get_childcanvas] {lappend @next_canvases $x}}
+	} else {
+		set @next_canvases {}
+	}
+	set @last_canvas 0
+	$self search_recursive
+}
+
+def FindModel end {} {
+	$self reinit
+	$@orig_canvas deselect_all
+	set @info " \"$@find_string\" not found"
+	foreach view $@views {
+		$view addw label "info" "info"
+	}
+}
+
+def FindModel cache_results {canvas} {
+	set @results {}
+	foreach child [$@objects values] {
+		if {[string first $@find_string [$child text] 0] >= 0} {
+			lappend @results $child
+		}
+	}
+	if {[llength $@results]} {return 1} else {return 0}
+}
+
+class_new FindView {FindModel} ;# no, using View is wrong here. View is for tk canvas item collections.
+def FindView widget {} {return .$@canvas.find}
+def FindView init {canvas} {
+	findmodel views+ $self
+	set @canvas $canvas
+	set @break 0
+	set f [$self widget]
+	frame $f -border 1 -relief ridge
+	$self addw button "close" ""
+	$self addw text "find" "find"
+	$self addw checkbutton "recursive" "recursive"
+	if {[winfo exists .$@canvas.yscroll]} {set w .$@canvas.yscroll} else {set w .$@canvas.c}
+	pack $f -side bottom -fill x -before $w
+	set string [findmodel find_string]
+	if {$string != ""} {$f.find insert 0 $string}
+}
+
+def FindView addw {type name label} {
+	set f [$self widget]
+	if {$label!=""} {
+		eval [concat [list pack [label $f.${label}_l -text ${label}: -font {helvetica -10} -pady 0] -side left]]
+	}
+	switch $type {
+		text {
+			entry $f.$name -width 10 -relief flat -bg white -borderwidth 0 -highlightthickness 0
+			bind $f.$name <Escape> "findmodel delete"
+			bind $f.$name <Return> "$self find"
+		}
+		checkbutton {
+			checkbutton $f.$name
+			if {$name == "recursive"} {$f.$name configure -variable _(findmodel:recursive)}
+		}
+		button {
+			button $f.$name -border 1 -command "findmodel delete" -image icon_close -width 9 -height 9
+			if {$name == "close"} {bind $f.$name <Return> "findmodel delete"}
+		}
+		label {label $f.$name -textvariable _(findmodel:info) -font {helvetica -10} -pady 0}
+	}
+	pack $f.$name -side left
+	bind $f.$name <Tab> "$self traversal %K %W forward"
+}
+
+def FindView find {} {
+	set f [$self widget]
+	findmodel find_string= [$f.find get]
+	findmodel search_recursive
+	focus .$@canvas.c
+}
+
+def FindView traversal {k w direction} {
+	set f [$self widget]
+	if {$w == "$f.recursive"} {set next $f.close} else {set next [tk_focusNext $w]}
+	focus $next
+}
+
+def Canvas check_findbar {} {
+	if {[info exists ::_(findmodel:_class)] && ![winfo exists .$self.find.find]} {FindView new $self}
+}
+
+def Canvas get_childcanvas {} {
+	set canvases {}
+	foreach child [$@objects values] {if {[$child class] == "Canvas"} {lappend canvases $child}}
+	return $canvases
+}
+
+def Canvas runcommand {} {$@runcommand pack_prompt}
+
+class_new Runcommand {Listener}
+def Runcommand canvas {} {return $@canvas}
+
+def Runcommand init {serf name command} {
+	set @history [History new 20]
+	set @serf ${serf}.run
+	set @command $command
+	set @expanded 0
+	set @canvas [string trimleft $serf "."]
+	set @defs {}
+	set @completions {}
+	set @comp_i 0
+	set @comp_s "666"
+	set @show_id 0
+	$self defs
+	set f $@serf
+	frame $f -border 1 -relief ridge
+	button $f.close -border 1 -command "$self unpack_prompt" -image icon_close -width 9 -height 9
+	bind $f.close <Return> "$self unpack_prompt"
+	pack $f.close -side left
+	bind $f.close <Tab> "$self traversal %K %W forward"
+	label $f.cmd_l -text Command: -font {helvetica -10} -pady 0
+	pack $f.cmd_l -side left
+	entry $f.entry -width 30 -relief flat -bg white -borderwidth 0 -highlightthickness 0
+	bind $f.entry <Escape> "$self unpack_prompt"
+	bind $f.entry <Control-g> "$self unpack_prompt"
+	bind $f.entry <Return> "$self eval"
+	bind $f.entry <Up>     "$self scroll_history +1"
+	bind $f.entry <Down>   "$self scroll_history -1"
+	bind $f.entry <Control-p>     "$self scroll_history +1"
+	bind $f.entry <Control-n>     "$self scroll_history -1"
+	bind $f.entry <Tab>    "$self completion +"
+	switch $::tcl_platform(os) {
+		Linux   {bind $f.entry <ISO_Left_Tab> "$self completion -"}
+		default {bind $f.entry    <Shift-Tab> "$self completion -"}
+	}
+	pack $f.entry -side left -fill x -expand yes
+	bind $f.entry <Control-Tab> "$self traversal %K %W forward"
+}
+
+def Runcommand pack_prompt {} {
+	set f $@serf
+	set @show_id [$@canvas show_id]
+	if {!$@show_id} {$@canvas show_id= 1}
+	if {[winfo exists .$@canvas.yscroll]} {set w .$@canvas.yscroll} else {set w .$@canvas.c}
+	pack $f -side bottom -fill x -before $w
+	focus $f.entry
+}
+
+def Runcommand unpack_prompt {} {
+	if {!$@show_id} {$@canvas show_id= 0}
+	pack forget $@serf
+	focus [$@canvas widget]
+}
+
+def Runcommand traversal {k w direction} {
+	set f $@serf
+	if {$w == "$f.entry"} {set next $f.close} else {set next [tk_focusNext $w]}
+	focus $next
+}
+
+def Runcommand eval {} {
+	set f $@serf
+	if {[winfo exists $f.completion]} {
+		set l [string range $@comp 0 [expr [string first ":" $@comp 0]-1]]
+		$self replace $l
+		destroy $f.completion
+		return
+	}
+	#$self unpack_prompt
+	super
+	$self unpack_prompt
+}
+
+def Runcommand defs {} {
+	set name [$@canvas class]
+	set len [string length ${name}_]
+	foreach def [$name methods] {lappend @defs $def}
+}
+
+def Runcommand completion {which} {
+	set f $@serf
+	set text [$f.entry get]
+	if {$text != $@comp_s} {
+		set @comp_s $text
+		set @completions {}
+		set @comp_i 0
+		foreach def $@defs {if {[regexp ^$@comp_s $def]} {lappend @completions $def}}
+	}
+	if {![llength $@completions]} return
+	set def [lindex $@completions $@comp_i]
+	set args [$@canvas args $def]
+	if {[lindex $args 0] == "self"} {
+		set args2 [lreplace $args 0 0]
+	} else {
+		set args2 $args
+	}
+	if {![llength $args2]} {set args2 "none"}
+	set @comp [join [list $def ":" $args2]]
+	if {$which == "+"} {
+		set @comp_i [expr ($@comp_i+1)%[llength $@completions]]
+	} else {
+		set @comp_i [expr $@comp_i-1]
+		if {$@comp_i<0} {set @comp_i [expr [llength $@completions]-1]}
+	}
+	if {![winfo exists $f.completion]} {
+		label $f.completion -textvariable _($self:comp) -pady 0
+		pack $f.completion -side right
+	}
+}
+
+def Thing args {def} {
+	set class [$self class]
+	set ancestors [$class ancestors]
+	set name ${class}_$def
+	set n 0
+	foreach class $ancestors {
+		set name ${class}_$def
+		if {[info exists ::__args($name)]} {break}
+	}
+	return $::__args($name)
+}
+
+def Canvas visible_rect {} {
+	set c [$self widget]
+	set height [winfo height $c]
+	set width [winfo width $c]
+	if {$width == 1 && $height == 1} {set height 300; set width 450}
+	mset {l r} [$c xview]
+	mset {t b} [$c yview]
+	if {$l == $r} {set l 0; set r 1}
+	if {$t == $b} {set t 0; set b 1}
+	set w [expr  $width / ($r - $l)]
+	set h [expr $height / ($b - $t)]
+	mset {l2 r2} [lmap * [list $l $r] $w]
+	mset {t2 b2} [lmap * [list $t $b] $h]
+	return [list $l2 $t2 $r2 $b2]
+}
+
+def Canvas clipboard_coords {offset} {
+	set in 0
+	foreach mess [pd_mess_split [$::clipboard value]] {
+		set type [lindex $mess 1]
+		switch $type {
+			canvas {set in 1} "" {} connect {}
+			default {
+				if {$type == "restore"} {set in 0}
+				mset {x y} [lmap + [lrange $mess 2 3] $offset]
+				if {!$in} {lappend xcoords $x; lappend ycoords $y}
+			}
+		}
+	}
+	return [list $xcoords $ycoords]
+}
+
+def Canvas paste_visible? {x1 y1 x2 y2 offset} {
+	set in 0
+	foreach mess [pd_mess_split [$::clipboard value]] {
+		set type [lindex $mess 1]
+		switch $type {
+			canvas {set in 1} "" {} connect {}
+			default {
+				if {$type == "restore"} {set in 0}
+				mset {x y} [lmap + [lrange $mess 2 3] $offset]
+				if {!$in} {
+					if {$x > $x2 || $x < $x1} {return 0}
+					if {$y > $y2 || $y < $y1} {return 0}
+				}
+			}
+		}
+	}
+	return 1
+}
+
+def Canvas copy_times= {c} {set @copy_count $c}
+def Canvas copy_times {} {return $@copy_count}
+
+def Canvas copy {} {
+	global clipboard obj_index_sel
+	if {![$@objectsel size]} {return}
+	$clipboard value= ""
+	$self copy_times= 1
+	array unset obj_index_sel $self:*
+	set j 0
+	foreach i [lsort -integer [$@objectsel keys]] {
+		set child [$@objectsel get $i]
+		#set obj_index_sel($self:$child) [$@objectsel search $child]
+		set obj_index_sel($self:$child) $j; incr j
+		$child deconstruct_to $clipboard
+	}
+	foreach wire [$@wiresel values] {
+		if {[array names obj_index_sel $self:[$wire from]] == ""} {continue}
+		if {[array names obj_index_sel $self:[$wire to  ]] == ""} {continue}
+		$wire deconstruct_to $clipboard $self
+	}
+}
+
+def Canvas paste {} {
+	if {[$self look snap_grid]} {set offset [$self look grid_size]} {set offset 15}
+	$self do_paste [expr [$self copy_times] * $offset]
+	$self copy_times= [expr [$self copy_times] + 1]
+}
+
+def Canvas do_paste {offset} {
+	set in 0
+	$self deselect_all
+	netsend [list .$self "push"]
+	foreach mess [pd_mess_split [$::clipboard value]] {
+		set type [lindex $mess 1]
+		if {$type == "restore"} {incr in -1}
+		if {!$in} {set with [list $self new_object_copyselect]} else {set with ""}
+		switch $type {
+			"" {}
+			canvas {incr in; netsend $mess}
+			connect {
+				if {$with != ""} {set with [list $self new_wire_select]}
+				netsend $mess $with}
+			default {netsend [$self paste_coords $mess $offset] $with}
+		}
+	}
+	netsend [list #X pop 1]
+}
+
+def Canvas paste_coords {mess offset} {
+	set x [lindex $mess 2]; set y [lindex $mess 3]
+	mset {vx1 vy1 vx2 vy2} [$self visible_rect]
+	mset {xcoords ycoords} [$self clipboard_coords $offset]
+	set visible [$self paste_visible? $vx1 $vy1 $vx2 $vy2 $offset]
+	set ref [lsearch $ycoords [lindex [lsort -real -increasing $ycoords] 0]]
+	if {!$visible} {
+		set xoff [expr ($vx2 - $vx1) * 0.25]
+		set yoff [expr ($vy2 - $vy1) * 0.25]
+		set x2 [expr [lindex $mess 2] - [lindex $xcoords $ref] + $vx1 + $xoff]
+		set y2 [expr [lindex $mess 3] - [lindex $ycoords $ref] + $vy1 + $yoff]
+		return [lreplace $mess 2 3 $x2 $y2]
+	} else {
+		puts "\t \t [expr $x+$offset] [expr $y+$offset] <<<<<"
+		return [lreplace $mess 2 3 [expr $x+$offset] [expr $y+$offset]]
+	}
+}
+
+def Canvas cut {} {
+	$@history atomically [list cut] {
+		$self copy
+		$self delete_selection
+	}
+}
+
+def Canvas duplicate {} {
+	if {[$self look snap_grid]} {set off [$self look grid_size]} {set off 15}
+	$self do_duplicate $off
+}
+
+def Canvas do_duplicate {offset} {
+	global clipboard
+	set backup $clipboard
+	set clipboard [Clipboard2 new]
+	$self copy
+	$self do_paste $offset
+	$clipboard delete
+	set clipboard $backup
+}
+
+def Canvas mouse_copy {} {
+	$self do_duplicate 0
+}
+
+def Canvas   select_all {} {
+	$self editmode= 1
+	eval [concat [list $@objectsel reinit] [$@objects list]]
+	eval [concat [list   $@wiresel reinit] [  $@wires list]]
+}
+def Canvas deselect_all {} {
+	#$self editmode= 1
+	$@objectsel clear
+	$@wiresel clear
+}
+
+def Canvas popup_help {} {$::main class_browser}
+
+def Canvas popup_open {} {
+	#$self init_window
+	#set @mapped 1
+	if {[winfo exists [$self widget]]} {raise .$self; return}
+	netsend [list .$self vis 1]
+	#$self init_window
+	#$self redraw
+}
+
+def Canvas popup {id x y} {
+	set p .$self.popup
+	catch {destroy $p}
+	menu $p -tearoff false
+	if {$id == $self} {
+		$self populate_menu $p {popup_properties popup_help}
+	} elseif {[$id class] == "Wire"} {
+		$id populate_menu $p {popup_insert}
+	} else {
+		$id populate_menu $p {popup_properties popup_open popup_help
+			popup_clear_wires popup_remove_from_path popup_delete_from_path popup_copy_id}
+	}
+	tk_popup $p [expr $x-5] [expr $y-5]
+}
+
+def View popup_copy_id {} {
+	clipboard clear
+	clipboard append $self
+}
+
+def Canvas disconnect {wire} {
+	set @keynav_tab_sel "wire"
+	set id [$@wires get [$self wire_idx $wire]]
+	if {$id == $@keynav_current || $id == $@keynav_last_wire} {
+		set @keynav_current 0
+		set @keynav_last_wire 0
+	}
+	mset {from outlet to inlet} $wire
+	netsend [list .$self disconnect $from $outlet $to $inlet]
+	$@history add [list $self    connect $wire]
+}
+def Canvas connect {wire {callback ""}} {
+	mset {from outlet to inlet} $wire
+	netsend [list .$self connect $from $outlet $to $inlet] $callback
+	$@history add [list $self disconnect $wire]
+}
+
+def Canvas clear_wires_of {obj} {
+    if {![llength [$obj ioselect]]} {
+	set port 0; set type "none"
+    } else {
+	set port [lindex [$obj ioselect] 0]
+	set type [lindex [$obj ioselect] 1]
+    }
+    foreach wire [$obj wires2] {
+	mset {from outlet to inlet} [$wire report]
+	switch $type {
+	    i {if {  $to==$obj &&  $inlet==$port} {$self disconnect [$wire connects]; if { !$inlet} {lappend @auto_wire_from $from}}}
+	    o {if {$from==$obj && $outlet==$port} {$self disconnect [$wire connects]; if {!$outlet} {lappend @auto_wire_to   $to  }}}
+	    none {
+		$self disconnect [$wire connects]
+		if {$from==$obj && !$outlet} {lappend @auto_wire_to   $to  }
+		if {  $to==$obj && ! $inlet} {lappend @auto_wire_from $from}
+	    }
+	}
+    }
+}
+
+def Canvas clear_wires {} {
+	set @auto_wire_to {}; set @auto_wire_from {}
+	if {[$@objectsel size] == 1} {
+		set objs [$@objectsel values]
+	} else {
+		if {![llength $@keynav_iosel_i] && ![llength $@keynav_iosel_o]} {return}
+		set objs [list $@keynav_iosel_i $@keynav_iosel_o]
+	}
+	foreach obj $objs {$self clear_wires_of $obj}
+}
+
+def Canvas reconnect {} {
+	foreach from $@auto_wire_from {
+		set idx1 [$@objects search $from]
+		foreach to $@auto_wire_to {
+			set idx2 [$@objects search $to]
+			set wire [list $idx1 0 $idx2 0]
+			if {[$self wire_idx $wire] < 0} {$self connect $wire}
+		}
+	}
+}
+
+def Canvas delete_obj_from_path {} {$self clear_wires; $self reconnect;	$self delete_selection}
+def Canvas remove_obj_from_path {} {$self clear_wires; $self reconnect}
+
+def Canvas wire_idx {connects} {
+	foreach {idx x} [$@wires list] {
+		if {[string compare [join $connects] [join [$x connects]]] == 0} {return $idx}
+	}
+	return -1
+}
+
+def Canvas reconnect_brkwires {type brk_quads obj} {
+	set k [$@objects search $obj]
+	foreach quad $brk_quads {
+		mset {from outlet to inlet} $quad
+		set orig_outlet $outlet; set orig_inlet $inlet
+		switch $type {
+			i {set orig_obj $to; set to $k; set inlet 0}
+			o {set orig_obj $from; set from $k; set outlet 0}
+		}
+		netsend [list .$self connect $from $outlet $to $inlet] 
+	}
+	if {$type == "i"} {
+		netsend [list .$self connect $k 0 $orig_obj $orig_inlet]
+	} else {
+		netsend [list .$self connect $orig_obj $orig_outlet $k 0]
+	}
+	$self new_object_callback $obj
+	
+}
+
+def Canvas expand_port {type k port} {
+	set obj [$@objects get $k]
+	mset {bx1 by1 bx2 by2} [$obj io_bbox $type $port]
+	mset {ox1 oy1 ox2 oy2} [$obj bbox]
+	mset ys [expr $oy2-$oy1]
+	mset {brk_wires brk_quads} [$self broken_wires $type $k $port $self]
+	switch $type {
+		i {mset {nx ny} [$self xy_snap $bx1 [expr $by1-25]]}
+		o {mset {nx ny} [$self xy_snap $bx1 [expr $by1+$ys+25]]}
+	}
+	foreach quad $brk_quads {$self disconnect $quad}
+	set reply [list $self reconnect_brkwires $type $brk_quads]
+	netsend [concat [list .$self obj $nx $ny] t a] $reply
+	
+}
+
+def Canvas outlet_expand {k outlet} {set reconnect [$self broken_wires o $k $inlet]}
+
+def Canvas implicit_wires {objs} {
+	set l {}; set h $@objects
+	foreach obj $objs {
+		set k [$h search $obj]
+		for {set i 0} {$i < [$obj ninlets]} {incr i} {
+			set ws [$self com_wires i $k $i]; if {[llength $ws]} {foreach w $ws {lappend l $w}}
+		}
+		for {set o 0} {$o < [$obj noutlets]} {incr o} {
+			set ws [$self com_wires o $k $o]; if {[llength $ws]} {foreach w $ws {lappend l $w}}
+		}
+	}
+	#return [lsort -integer -unique $l]
+	return [lsort -unique $l]
+}
+
+def Canvas com_wires {type k port} {
+	set h $@objectsel; set obj [$@objects get $k]; set wires [$obj wires2]; set l {}
+	foreach wire $wires {
+		mset {f2 o2 t2 i2} [$wire connects]
+		if {$t2==$k && $i2==$port && $type=="i" && [$h exists $f2]} {lappend l $wire}
+		if {$f2==$k && $o2==$port && $type=="o" && [$h exists $t2]} {lappend l $wire}
+	}
+	return $l
+}
+
+def Canvas broken_wires {type k port canvas} {
+	set shash [$canvas objectsel]
+	set obj [[$canvas objects] get $k]
+	set wires [$obj wires2]; set brk_wires {}; set quads {}
+	foreach wire $wires {
+		mset {f2 o2 t2 i2} [$wire connects]
+		if {$t2==$k && $i2==$port && $type=="i" && ![$shash exists $f2]} {
+			lappend brk_wires $wire; lappend quads [$wire connects]
+		}
+		if {$f2==$k && $o2==$port && $type=="o" && ![$shash exists $t2]} {
+			lappend brk_wires $wire; lappend quads [$wire connects]
+		}
+	}
+	return [list $brk_wires $quads]
+}
+
+
+def Canvas selection_center {} {
+	set x 0; set y 0
+	foreach obj [$@objectsel values] {
+		mset {x1 y1} [$obj xy]
+		incr x $x1
+		incr y $y1
+	}
+	set n [$@objectsel size]
+	set x [expr $x / $n]
+	set y [expr $y / $n]
+	return [list $x $y]
+}
+
+# translate the key/idx in $@objects to key/idx in $@objectsel
+def Canvas idx_map {idx} {
+	set i 0; set obj [$@objects get $idx]
+	foreach sobj [$@objectsel values] {if {$obj == $sobj} {return $i}; incr i}
+	return -1
+}
+
+def Canvas subpatcherize_mkio {center iolist offset} {
+	mset {x y} $center; set inx 0; set outx 0
+	for {set i 0} {$i < [llength $iolist]} {incr i} {
+		mset {type io port dsp} [lindex $iolist $i]
+		if {$type == "i"} {
+			if {$dsp} {set inlet "inlet~"} {set inlet "inlet"}
+			netsend [list #X obj [expr ($inx+1)*100] 0 $inlet]
+			netsend [list #X connect $offset 0 $io $port]
+			incr inx
+		} else {
+			if {$dsp} {set outlet "outlet~"} {set outlet "outlet"}
+			netsend [list #X obj [expr ($outx+1)*100] [expr $y*2] $outlet]
+			netsend [list #X connect $io $port $offset 0]
+			incr outx
+		}
+		incr offset
+	}
+}
+
+def Canvas subpatcherize_iopos {orig io} {
+	set tab {}; set result {}
+	for {set x 0} {$x < [llength $orig]} {incr x} {
+		mset {from k1 io1 dsp} [lindex $orig $x]; mset {k2 io2} [lindex $io $x]
+		set obj1 [$@objects get $k1]
+		mset {x1 y1 x2 y2} [$obj1 io_bbox $from $io1]; set x1 [expr int($x1)]
+		lappend pos $x1; lappend tab [list $k1 $x1 [list $k2 $io2 $dsp]]
+		#lappend pos $x1; lappend tab [list $k1 $x1 [list $k2 $io2]]
+	}
+	set tab [lsort -index 1 -real $tab]; set foo ""
+	foreach item $tab {mset {k1 val foo2} $item; if {$foo2 != $foo} {lappend result $foo2}; set foo $foo2}
+	return $result
+}
+
+def Canvas subpatcherize {} {
+	set center [$self selection_center]
+	set rewire_off [llength [$@objectsel values]]
+	set ins {}; set outs {}; set toins {}; set fromouts {}; set broken {}; set iolist {}
+	foreach obj [$@objectsel values] {
+		for {set i 0} {$i < [$obj ninlets]} {incr i} {
+			mset {brk_wires brk_quads} [$self broken_wires i [$@objects search $obj] $i $self]
+			if {[llength $brk_wires]} {
+				foreach wire $brk_quads {
+					set out_obj_name [[$@objects get [lindex $wire 0]] text]
+					if {[regexp {~} $out_obj_name]} {set dsp 1} {set dsp 0}
+					lappend broken [concat i $wire $dsp]
+				}
+			}
+		}
+		for {set o 0} {$o < [$obj noutlets]} {incr o} {
+			mset {brk_wires brk_quads} [$self broken_wires o [$@objects search $obj] $o $self]
+			if {[llength $brk_wires]} {
+				foreach wire $brk_quads {
+					set out_obj_name [[$@objects get [lindex $wire 0]] text]
+					if {[regexp {~} $out_obj_name]} {set dsp 1} {set dsp 0}
+					lappend broken [concat o $wire $dsp]
+				}
+			}
+		}
+	}
+	# $broken stores totall number of broken connections, i= need [inlet] o = need [outlet]
+	foreach c $broken {
+		mset {type f o t i dsp} $c
+		if {$type == "i"} {
+			lappend ins [list $t $i];lappend toins [list o $f $o $dsp]
+		} else {
+			lappend outs [list $f $o]; lappend fromouts [list i $t $i $dsp]
+		}
+	}
+	# figures out the inlet/outlet positioning and num of in/outlet to create
+	set ins [$self subpatcherize_iopos $toins $ins]
+	set outs [$self subpatcherize_iopos $fromouts $outs]
+	# iolist stores in/outlets to be conected inside the subpatch
+	foreach in   $ins {mset {idx p dsp}  $in; lappend iolist [list i [$self idx_map $idx] $p $dsp]}
+	foreach out $outs {mset {idx p dsp} $out; lappend iolist [list o [$self idx_map $idx] $p $dsp]}
+	puts "\t \t Cutting..............."
+	$self cut
+	puts "\t \t Push.................."
+	netsend [list .$self "push"]
+	netsend [list #N canvas 0 0 450 300 sub 0] [list $self subpatcherize_id]
+	puts "\t \t Push clipboard........"
+	foreach mess [pd_mess_split [$::clipboard value]] {netsend $mess}
+
+	#creating in/outlets
+	$self subpatcherize_mkio $center $iolist $rewire_off
+	#netsend [list [concat #X restore $center pd sub]]
+	netsend [concat #X restore $center pd sub]
+	puts "\t \t Pop..................."
+	netsend [list .$self "pop"] [list $self subpatcherize_rewire $broken $ins $outs]
+}
+
+def Canvas subpatcherize_id {id} {set @subpatcherize_id $id} 
+
+def Canvas subpatcherize_rewire {wires inlist outlist bogus} {
+	set obj $@subpatcherize_id
+	foreach wire $wires {
+		mset {type f o t i dsp} $wire
+		if {$type == "i"} {
+			set idx [lsearch $inlist [list $t $i $dsp]]
+			$self connect [list $f $o [$@objects search $obj] $idx]
+		} else {
+			set idx [lsearch $outlist [list $f $o $dsp]]
+			$self connect [list [$@objects search $obj] $idx $t $i]
+		}
+	}
+}
+
+def Canvas end_action {} {
+	switch -- $@action {
+	  none    {post "ending action 'none' makes no sense"}
+	  default {$@action delete; set @action "none"}
+	}
+}
+
+proc shift?    {f} {return [expr $f&1]}
+proc ctrl?     {f} {return [expr $f&2]}
+proc alt?      {f} {return [expr $f&4]}
+proc button_of {f} {
+#	set f [expr $f>>8]
+#	set b 1
+#	while {[expr $f&1==0} {set f [expr $f>>1]}
+#	return $f
+	return [expr $f>>8]
+}
+
+class_new FutureWire {View}
+def FutureWire init {canvas x y f target} {
+	super
+	set @canvas $canvas
+	mset {type from port} $target
+	switch $type {
+	    outlet {
+		set @from $from; set @outlet $port
+		set   @to ""   ; set @inlet ""
+		set port_name ${from}o${port}
+	    }
+	    inlet {
+		set @from ""   ; set @outlet ""
+		set   @to $from; set @inlet $port
+		set port_name ${from}i${port}
+	    }
+	}
+	mset {x y} [lmap / [rect_centre [[$@canvas widget] bbox $port_name]] [$@canvas zoom]]
+	set @x1 $x
+	set @y1 $y
+	$self motion $@x1 $@y1 $f $target
+}
+def FutureWire motion {x y f target} {
+	set @x2 $x
+	set @y2 $y
+	mset [list type foo bar] $target
+	$self draw
+}
+def FutureWire unclick {x y f target} {
+	mset [list type foo bar] $target
+	mset {obj iox ioy io idx} [$@canvas iohilite]
+	if {$obj != -1} {
+		switch $io {i {set type "inlet"} o {set type "outlet"}}
+		set target [list $type $obj $idx]
+	}
+	switch $type {
+		outlet {mset [list type @from @outlet] $target}
+		inlet  {mset [list type   @to  @inlet] $target}
+		default {}
+	}
+	set from_idx [[$@canvas objects] search $@from]
+	set   to_idx [[$@canvas objects] search $@to]
+	if {$from_idx >= 0 && $to_idx >= 0 && $@from != $@to} {
+		$@canvas connect [list $from_idx $@outlet $to_idx $@inlet]
+	}
+	if {![shift? $f]} {$@canvas end_action}
+}
+def FutureWire draw {} {
+	$self item WIRE line [xys $@x1 $@y1 $@x2 $@y2] -dash {4 4 4 4} -fill [$self look dash] -smooth yes 
+}
+
+class_new GopRect {View}
+
+def GopRect init {canvas rect} {
+	set @canvas $canvas
+	set @rect $rect
+}
+
+def GopRect draw {} {
+	$self item GOPRECT rectangle $@rect -outline [$self look fg]
+}
+
+class_new SelRect {View}
+def SelRect init {canvas x y bf target} {
+	super
+	set @x1 $x
+	set @y1 $y
+	set @canvas $canvas
+	$self motion $x $y 0 $target
+}
+def SelRect motion {x y f target} {
+	set @x2 $x
+	set @y2 $y
+	$self draw
+}
+def SelRect unclick {x y f target} {
+	$self motion $x $y 0 $target
+	set sel {}
+	set c [$@canvas widget]
+	mset {x1 y1 x2 y2} [lmap * [list $@x1 $@y1 $@x2 $@y2] [$@canvas zoom]]
+	set sel [$c find overlapping $x1 $y1 $x2 $y2]
+	set selrect_index [lsearch $sel [$c find withtag selrect]]
+	set sel [lreplace $sel $selrect_index $selrect_index]
+	if {[llength $sel]} {
+		set objects {}
+		#set wires {}
+		foreach tag $sel {
+			if {[regexp {^[xo]?[0-9a-f]{6,8}} [$c gettags $tag] id]} {
+				if {[$@canvas == $id]} {continue}
+				if {[[$id class] <=  Box]} {lappend objects $id}
+				#elseif {[[$id class] <= Wire]} {lappend wires   $id}
+			}
+		}
+		set objects [lsort -unique $objects]
+		#set wires   [lsort -unique $wires]
+		set objects2 {}
+		#so that objects in gop won't get selected...
+		foreach obj $objects {if {[$obj canvas] == $@canvas} {lappend objects2 $obj}}
+		$@canvas selection+= $objects2
+		#$@canvas selection_wire+= $wires
+	}
+	$@canvas selection_wire+= [$@canvas implicit_wires $objects]
+	set _($@canvas:keynav_tab_sel) "wire"
+	$@canvas end_action
+	
+}
+def SelRect draw {} {
+	$self item RECT line [list $@x1 $@y1 $@x2 $@y1 $@x2 $@y2 $@x1 $@y2 $@x1 $@y1] \
+	    -fill [$self look rect] -dash {3 3 3 3} -dashoffset 3 
+}
+
+def Canvas click {x y f target} {
+	if {[winfo exists .completion]} {
+		raise .completion
+		focus .completion.comp
+		return
+	}
+	mset {type id detail} $target
+	set c [$self widget]
+	focus $c
+	set @click_at [list $x $y]
+	if {$f&8} {if {$id == ""} {set id $self}; $self right_click $id $x $y; return}
+	if {!$@editmode} {$self click_runmode $id $x $y $f $target; return}
+	set in_selection [expr [$@objectsel search $id]>=0]
+	switch $@action {
+		mouse_copy {$self move_selection}
+	}
+	switch $type {
+		outlet {}
+		inlet {}
+		object {$self click_on_object $id $f}
+		wire {$self click_on_wire $id $f $x $y}
+		nothing {
+			#$self deselect_all
+			if {[lindex $@iohilite 0] == -1} {
+				$self click_on_nothing $f $target $x $y
+				return
+			}
+		}
+		label {$self click_on_object $id $f}
+		default {error "BORK: $type"}
+	}
+	if {$@iohilite != "" && $type != "wire"} {
+		mset {obj iox ioy io idx} $@iohilite
+		if {$obj < 0} {return}
+		switch $io {
+			i {set type "inlet"}
+			o {set type "outlet"}
+		}
+		if {$@action == "none" && [$obj canvas] == $self} {
+			set @action [FutureWire new $self $iox $ioy $f [list $type $obj $idx]]
+		}
+		return
+	}
+}
+
+def Canvas click_runmode {id x y f target} {
+	foreach obj [$self selection] {if {[[$obj class] <= AtomBox]} {$obj unedit}}
+	$self deselect_all
+	#if {$@focus != ""} {if {[[$@focus class] <= TextBox]} {$self selection-= $@focus;$@focus unedit}}
+	if {[llength $id]} {
+		if {[$id class] != "Canvas"} {
+			$id click $x $y $f $target
+		} else {
+			if {[$id subpatch]} {
+				if {![$id mapped]} {$id popup_open} else {if {![$id gop]} {raise .$id}}
+			}
+		}
+	}
+}
+
+def Canvas click_on_object {id f} {
+	set c [$self widget]; set text $c.${id}text
+	# so that if one clicks on the objectbox when editing the objectname, the focus won't get lost
+	if {[winfo exists $text]} {focus $text; return}
+	switch [expr $f&255] {
+		0 {
+			if {[$self action] == "mouse_copy"} {$self action= "none"; return}
+			# if $id is the content of GOP
+			if {[$id canvas] != $self} {
+				set obj [$id get_parent_gop $self]
+			} else {set obj $id}
+			if {[$@objectsel search $obj] < 0 || [$@objectsel size] == 0} {
+				$self deselect_all
+				$self selection+= $obj
+				set @action edit
+			} else {set @action edit}
+		}
+		1 {
+			if {[$@objectsel search $id] < 0} {
+				$self selection+= $id
+			} else {
+				$self selection-= $id
+			}
+		}
+		2 {
+			if {![llength [$id wires2]]} {return}
+			$self deselect_all
+			$self selection+= $id
+			$self remove_obj_from_path
+		}
+		3 {
+			if {[$id canvas] != $self} {
+				set obj [$id get_parent_gop $self]
+			} else {set obj $id}
+			if {![$@objectsel size]} {$self selection+= $obj}
+			if {[$@objectsel search $obj] < 0} {
+				$self deselect_all
+				$self selection+= $obj
+			}
+			$self action= "mouse_copy"
+		}
+	}
+}
+def Canvas click_on_wire {id f x y} {
+	set obj_selection [$self selection]
+	if {[llength $obj_selection]} {$self selection-= $obj_selection}
+	set @keynav_tab_sel "object"
+	switch [expr $f&255] {
+		0 {$self selection_wire= $id}
+		1 {$self selection_wire+= $id}
+		2 {
+			set c [$self widget]
+			set wire [$id connects]
+			$self disconnect $wire
+			set from [$@objects get [lindex $wire 0]]; set outlet [lindex $wire 1]
+			set to   [$@objects get [lindex $wire 2]]; set  inlet [lindex $wire 3]
+			set opos [lmap / [rect_centre [$c bbox ${from}o${outlet}]] [$self zoom]]
+			set ipos [lmap / [rect_centre [$c bbox   ${to}i${inlet}]]  [$self zoom]]
+			set  pos [list $x $y]
+			if {[distance $pos $opos] > [distance $pos $ipos]} {
+				mset {x1 y1} $ipos
+				set target [list outlet $from $outlet]
+			} else {
+				mset {x1 y1} $opos
+				set target [list inlet $to $inlet]
+			}
+			set @action [FutureWire new $self $x1 $y1 $f $target]
+		}
+	}
+}
+
+def Canvas click_on_nothing {f target x y} {
+	# this cget check actually saves a full tk redraw
+	if {[[$self widget] cget -cursor] != {}} {[$self widget] configure -cursor {}}
+	if {$@focus != ""} {if {[[$@focus class] <= TextBox]} {$@focus unedit}}
+	if {$@action == "insert"} {return}
+	if {![expr $f&255]} {
+		$self deselect_all
+		#$self click_deselect_io
+	}
+	switch $@action {
+		edit {}
+		move {}
+		none {}
+		insert {}
+		chain_obj {}
+		imove {}
+		mouse_copy {}
+		default {$@action unclick $x $y $f $target}
+	}
+	set @action [SelRect new $self $x $y $f $target]
+}
+
+def Canvas right_click {id x y} {
+	set c [$self widget]
+	set @insert_x $x; set @insert_y $y
+	if {$id != $self} {set id [$self gop_target $id]}
+	$self popup $id [winfo pointerx $c] [winfo pointery $c]
+}
+
+def Canvas unclick {x y f target} {
+	set c [$self widget]
+	mset {type id detail} $target
+	if {$@editmode} {
+		switch $@action {
+			edit {
+				if {[$id canvas] != $self} {
+					set obj [$id get_parent_gop $self]
+				} else {set obj $id}
+				if {[$id class] == "Canvas"} {if {[$id text] == "graph"} {set @action none; return}}
+				set focus [$self focus]
+				if {$focus != ""} {if {[[$focus class] <= TextBox]} {$focus unedit}}
+				$obj edit; set @action none; $obj changed action
+			}
+			move {$self unclick_move}
+			none {}
+			insert {}
+			chain_obj {}
+			mouse_copy {$self mouse_copy}
+			imove {$self unclick_move}
+			default {$@action unclick $x $y $f $target}
+		}
+	} else {$self unclick_runmode $target $f $x $y}
+	$self adjust_scrollbars
+	#$self checkgeometry
+}
+
+def Canvas unclick_move {} {
+	$self move_selection
+	set @action none
+}
+
+def Canvas move_selection {} {
+	foreach obj [$@objectsel values] {
+		if {![[$obj class] <= Box]} {
+			puts "Canvas unclick warning: trying to move non-Box explicitly"
+			continue
+		}
+		mset {x1 y1} [$obj xy]
+		switch $@action {
+			mouse_copy {}
+			default {$obj position= [$obj backupxy]}
+		}
+		$obj moveto $x1 $y1
+		if {[$obj edit?]} {focus [[$obj canvas] widget].${obj}text}
+	}
+	set objs [$@objectsel values]
+}
+
+def Canvas unclick_runmode {target f x y} {
+	if {[$self focus] != ""} {[$self focus] unclick $x $y $f $target}
+	mset {type id detail} $target
+	if {$id != ""} {
+		if {[$id class] == "Array"} {$id unclick $x $y $f $target; return}
+	}
+}
+
+def Canvas get_bbox {} {return $@bbox}
+
+if {$have_expand} {
+	def Canvas notice {origin args} {$self child_changed $origin {expand}$args}
+} else {
+	def Canvas notice {origin args} {eval [concat [list $self child_changed $origin] $args]}
+}
+
+def Canvas tab_jump {} {
+	if {![$@objects size]} {return}
+	set @keynav 1
+	set olength [$@objectsel size]
+	set wlength [  $@wiresel size]
+	if {$@keynav_tab_sel == "object"} {
+		if {[$@wires size]} {set @keynav_tab_sel "wire"}
+	} else {
+		set @keynav_tab_sel "object"
+	}
+	switch $@keynav_tab_sel {
+		object {$self tab_jump_object}
+		wire {$self tab_jump_wire}
+	}
+}
+
+def Canvas tab_jump_wire {} {
+	# if no selection done by the mouse
+	if {![$@wiresel size]} {
+		# see if the selected object has wire, if yes, use it
+		# if keynav_current is already a wire, do nothing
+		if {[$@keynav_current class] != "Wire"} {
+			#use the last key selected wire as start if there is one
+			if {$@keynav_last_wire != 0} {
+				$self deselect_all
+				set @keynav_current $@keynav_last_wire
+			} else {
+				if {[llength [$@keynav_current wires2]]} {
+					$self deselect_all
+					set @keynav_current [lindex [$@keynav_current wires2] 0]
+					set @keynav_last_wire $@keynav_current
+				} else {
+					# check if the canvas has wires, if yes, use it
+					if {[$@wires size]} {
+						$self deselect_all
+						set @keynav_current [lindex [$@wires values] 0]
+						set @keynav_last_wire $@keynav_current
+					} else {return}
+
+				}
+			}
+		}
+	}
+	$self selection_wire= $@keynav_current
+}
+
+def Canvas tab_jump_object {} {
+	set olength [$@objectsel size]
+	# if there is no selection done by mouse
+	if {!$olength} {
+		# if keynav_current is 0, aka the start of key navigation
+		if {$@keynav_current == 0} {
+			if {[$@objects size]} {set @keynav_current [lindex [$@objects values] 0]} else {return}
+		} else {
+			# if the keynav_current is a wire, set keynav_current to a object
+			if {[$@keynav_current class] == "Wire"} {
+				set @keynav_last $@keynav_current
+				$self deselect_all
+				# use the last key selected obj as the start if there is one
+				if {$@keynav_last_obj != 0} {
+					set @keynav_current $@keynav_last_obj
+				} else {
+					set @keynav_current [lindex [$@keynav_current report] 0]
+					set @keynav_last_obj $@keynav_current
+				}
+			}
+		}
+	} elseif {$olength == 1}  {
+		set @keynav_current [lindex [$@objectsel values] 0]
+		$self deselect_all
+	} else {
+		$self deselect_all
+		set @keynav_current [$@objects get 0]
+		set @keynav_last_obj $@keynav_current
+	}
+	$self selection= $@keynav_current
+}
+
+def Canvas key_nav_up          {} {$self key_nav +1 -1 0}
+def Canvas key_nav_down        {} {$self key_nav -1 +1 0}
+def Canvas key_nav_right       {} {$self key_nav -1 -1 0}
+def Canvas key_nav_left        {} {$self key_nav +1 +1 0}
+def Canvas key_nav_up_shift    {} {$self key_nav +1 -1 1}
+def Canvas key_nav_down_shift  {} {$self key_nav -1 +1 1}
+def Canvas key_nav_right_shift {} {$self key_nav -1 -1 1}
+def Canvas key_nav_left_shift  {} {$self key_nav +1 +1 1}
+
+def Canvas key_nav {du dv shift} {
+	if {$@keynav_shift && !$shift} {}
+	set @keynav_shift $shift
+	if {[$@objectsel size] > 1} {
+		if {[llength $@keynav_iosel_i] > 0 || [llength $@keynav_iosel_o] > 0} {
+			#$self deselect_all
+		}
+	}
+	if {!$@keynav} {$self tab_jump}
+	switch $@keynav_tab_sel {
+	    object {
+		set @keynav_next [$self quadrant $du $dv [$@objects values]]
+		if {!$shift} {
+			$self selection-= $@keynav_current
+			$@keynav_current selected?= 0
+			set @keynav_last_obj $@keynav_next
+		}
+		if {[$@objectsel search $@keynav_next] < 0} {$self selection+= $@keynav_next}
+	    }
+	    wire {
+		#$@keynav_current selected?= 0
+		set @keynav_next [$self quadrant $du $dv [$@wires values]]
+		if {!$shift} {
+			$self selection_wire-= $@keynav_current
+			$@keynav_current selected?= 0
+			set @keynav_last_wire $@keynav_next
+		}
+		if {[$@wiresel search $@keynav_next] < 0} {$self selection_wire+= $@keynav_next}
+	    }
+	}
+	#$self selection+= $@keynav_next
+	set @keynav_current $@keynav_next
+}
+
+def Canvas victim {} {
+	if {[$@objectsel size]} {return [$@objectsel values]}
+	if {[string compare $@keynav_current 0]} {return {}}
+	return $@keynav_current
+}
+
+def Canvas key_nav_ioselect {} {
+	if {![$@objectsel size]} {return}
+	set var [lindex [$@objectsel values] end]
+	if {$@keynav_iosel != $var} {set @keynav_iocount 0}
+	if {$@keynav_port != 0 && $@keynav_iosel == $var} {
+		#set hilitebox $@keynav_port
+		foreach io $@keynav_port2 {[$self widget] delete ${io}b}
+	}
+	set obj [lindex [$@objectsel values] 0]
+	set ins  [$obj ninlets]
+	set outs [$obj noutlets]
+	set ports {}; set ports2 {}; set ports3 {}
+	for {set i 0} {$i < $ins}  {incr i} {lappend ports ${obj}i${i}; lappend ports2 "i"; lappend ports3 $i}
+	for {set i 0} {$i < $outs} {incr i} {lappend ports ${obj}o${i}; lappend ports2 "o"; lappend ports3 $i}
+	#incr @keynav_iocount
+	if {$@keynav_iocount >= [llength $ports]} {set @keynav_iocount 0}
+	set port [lindex $ports3 $@keynav_iocount]
+	set type [lindex $ports2 $@keynav_iocount]
+	set @keynav_port ${obj}${type}${port}
+	set @keynav_port2 {}
+	# @keynav_port stores the current hilited in/outlets
+	# @keynav_ports stores the current hilited in/outlets if there are multiple objects
+	# @keynav_iosel_i stores the selected inlets
+	# @keynav_iosel_o stores the selected outlets
+	foreach object [$@objectsel values] {
+		if {$@keynav_iosel != $var} {set @keynav_iosel $var}
+		switch $type {
+			i {
+				if {[lsearch $@keynav_iosel_i $object] == -1} {
+					lappend @keynav_iosel_i $object
+					set find [lsearch $@keynav_iosel_o $object]
+					if {$find >= 0} {set @keynav_iosel_o [lreplace $@keynav_iosel_o $find $find]}
+				}
+			}
+			o {
+				if {[lsearch $@keynav_iosel_o $object] == -1} {
+					lappend @keynav_iosel_o $object
+					set find [lsearch $@keynav_iosel_i $object]
+					if {$find >= 0} {set @keynav_iosel_i [lreplace $@keynav_iosel_i $find $find]}
+				}
+			}
+		}
+		mset {x y x1 y1} [[$self widget] bbox ${object}${type}${port}]
+		lappend @keynav_port2 ${object}${type}${port}
+		set _($object:ioselect) [list [lindex $ports3 $@keynav_iocount] [lindex $ports2 $@keynav_iocount]]
+		#set _($object:ioselect) [lindex $ports3 $@keynav_iocount]
+		$object hilite_io [lindex $ports2 $@keynav_iocount] [expr $x/$@zoom] [expr $y/$@zoom]
+	}
+	incr @keynav_iocount
+	
+}
+
+def Canvas keyboard_mode {} {
+	post "loading keyboard-mode...."
+	if {[file exists kb-mode.tcl]} {
+		package require kb-mode
+		$@runcommand defs
+		if {![info exists @kbcursor]} {set @kbcursor [kb-mode_init $self]}
+		puts "cursor::: $@kbcursor"
+	}
+}
+
+def Canvas keyboard_mode_exit {} {
+	post "exiting keyboard-mode...."
+	package forget kb-mode
+	remove_callback kb-mode
+	$@runcommand defs
+	$@kbcursor delete
+	read_ddrc
+	remove_callback "kb-mode"
+	unset @kbcursor
+}
+
+def Canvas keyprefix {} {
+	if {!$@keyprefix} {set @keyprefix 1} else {set @keyprefix 0}
+}
+
+def Canvas click_deselect_io {} {
+	if {[llength $@keynav_iosel_i] || [llength $@keynav_iosel_o]} {
+		if {!$@iosel_deselect} {set @iosel_deselect 1} else {$self dehilite_io; set @iosel_deselect 0}
+	} else {
+		$self dehilite_io
+	}
+}
+
+def Canvas dehilite_io {} {
+	foreach io [concat $@keynav_iosel_i $@keynav_iosel_o] {
+		puts "$io is a [$io class]"
+		set box $_($io:ioselect)
+		set type [lindex $_($io:ioselect) 1]
+		set port [lindex $_($io:ioselect) 0]
+		set tag ${io}${type}${port}
+		[$self widget] delete ${tag}b
+		set _($io:ioselect) {}
+	}
+	set @keynav_iosel_i {}
+	set @keynav_iosel_o {}
+	set @keynav_port 0
+	set @keynav_iocount 0
+}
+
+def Canvas incr_scale {} {$self scale out}
+def Canvas decr_scale {} {$self scale in}
+
+def Canvas scale {mode} {
+	set s $::scale_amount
+	switch $mode { in { set s [expr 1/$s] }}
+	set sel [$@objectsel values]
+	if {![llength $sel]} {set sel [$@objects values]}
+	foreach child $sel {
+		mset {x y} [$child xy]
+		set x1 [expr $x*$s]
+		set y1 [expr $y*$s]
+		$child position= [list $x1 $y1]
+		netsend [list .$self object_moveto $child $x1 $y1]
+	}
+	foreach child $sel {$child changed_wires}
+}
+
+def Canvas incr_zoom {} {$self zooming in}
+def Canvas decr_zoom {} {$self zooming out}
+def Canvas zooming {mode} {
+	global zoom bar
+	set spinbox .$self.bbar.scale
+	set val [string trimright [$spinbox get] %]
+	set i [lsearch $zoom(canned) $val]
+	set end [expr [llength $zoom(canned)] - 1]
+	switch -regexp $mode {
+	   in|up   {if {$i<$end} {incr i +1}}
+	  out|down {if {$i>0}    {incr i -1}}
+	}
+	set per [lindex $zoom(canned) $i]
+	$spinbox set $per%
+	set @zoom [expr $per/100.0] ;# @zoom must be float, not int
+	#$self propagate_zoom $@zoom
+	$self redraw
+	if {[$self look gridstate]} {if {$@editmode} {$@grid erase}}
+	foreach child [$@objects values] {if {[$child class] == "Canvas" && [$child gop]} {$child all_changed}}
+}
+
+def Canvas propagate_zoom {zoom} {
+	foreach child [$@objects values] {
+		if {[$child class] == "Canvas"} {
+			set @zoom $zoom
+			$child propagate_zoom $zoom
+		}
+	}
+}
+
+#-----------------------------------------------------------------------------------#
+set lastcanvasconfigured ""
+set lastcanvasconfiguration ""
+
+def Canvas checkgeometry {} {
+    set topname .$self
+    set boo [winfo geometry $topname.c]
+    set boo2 [wm geometry $topname]
+    global lastcanvasconfigured lastcanvasconfiguration
+    if {$topname != $lastcanvasconfigured || $boo != $lastcanvasconfiguration} {
+    	    set lastcanvasconfigured $topname
+    	    set lastcanvasconfiguration $boo
+    }
+}
+#-----------------------------------------------------------------------------------#
+def Canvas selection_move {dx dy} {
+	$@history atomically [list move] {
+		$self selection_move2 $dx $dy
+	}
+}
+def Canvas selection_move2 {dx dy} {
+	if {![$self editmode]} {return}
+	foreach o [$@objectsel values] {
+		mset {x1 y1} [$o xy]
+		if {[[$o class] <= Box]} {
+			$o moveto [expr $x1+$dx] [expr $y1+$dy]
+		} else {
+			puts "selection_move: $o is not a Box, it's a [$o class]"
+		}
+	}
+}
+
+def Canvas key {x y key iso shift} {
+	global tooltip; if {$tooltip ne ""} {$tooltip delete; set tooltip ""}
+	#if {[modes_callback $self "key" $x $y $key $iso $shift]} {return}
+	#if {[$self focus] != ""} {[$self focus] key $key $shift}
+	#if {$iso != ""} {scan $iso %c key}
+	#set focus [$self focus]
+	if {!$@editmode && [llength [$self selection]] == 1} {
+		set obj [$self selection]
+		if {[[$obj class] <= AtomBox]} {
+			if {[regexp {^[a-zA-Z0-9~/\._]{1}$} $key]} {$obj text= $key} {return}
+			$obj edit
+			$obj clear 0
+			return
+		}
+	}
+	if {$shift} {
+		if {[$self look snap_grid]} {set motion [expr [$self look grid_size]*2]} {set motion 10}
+	} else {
+		if {[$self look snap_grid]} {set motion [$self look grid_size]} {set motion 1}
+	}
+	set n [$@objectsel size]
+	switch -regexp -- $key {
+		BackSpace|Delete|KP_Delete {$self delete_selection}
+		Up    {if {$n} {$self arrow_key 0 -$motion} else {$self scroll y -$motion}}
+		Down  {if {$n} {$self arrow_key 0 +$motion} else {$self scroll y +$motion}}
+		Left  {if {$n} {$self arrow_key -$motion 0} else {$self scroll x -$motion}}
+		Right {if {$n} {$self arrow_key +$motion 0} else {$self scroll x +$motion}}
+		Tab   {$self tab_jump}
+		Return {$self return_key $x $y $key $iso $shift}
+		F1 {$self deselect_all}
+		F2 {set @keynav 0; $@active hide}
+		default {}
+	}
+}
+
+def Canvas return_key {x y key iso f} {
+	mset {type id detail} [$self identify_target $x $y $f]
+	if {![llength $@keynav_iosel_i] && ![llength $@keynav_iosel_o]} {
+		if {[$@objectsel size] == 1} {
+			mset {bx1 by1 bx2 by2} [[$self selection] bbox]
+			set x1 [expr ($bx1+$bx2)/2]; set y1 [expr ($by1+$by2)/2]
+			$self click_wrap $x1 $y1 1 $f
+			$self unclick_wrap $x1 $y1 1 $f
+		}
+	} else {
+		foreach out_obj $@keynav_iosel_o {
+			set from [$@objects search $out_obj]
+			set outlet [lindex $_($out_obj:ioselect) 0]
+			foreach in_obj $@keynav_iosel_i {
+				set to [$@objects search $in_obj]
+				set inlet [lindex $_($in_obj:ioselect) 0]
+				$self connect [list $from $outlet $to $inlet]
+			}
+		}
+		$self dehilite_io
+	}
+
+}
+
+def Canvas arrow_key {val1 val2} {
+	if {![$self editmode]} {
+		if {[$@objectsel size] == 1} {
+			set o [$@selection values]
+			if {[[$o class] <= IEMGUI] || [[$o class] == FloatBox]} {$o key_incr $val1 $val2}
+		}
+	} else {
+		$self selection_move $val1 $val2
+	}
+}
+
+def Canvas clear_selection {} {
+	if {[$@objectsel size] > 0 || [$@wiresel size] > 0} {
+		$self deselect_all
+		$self dehilite_io
+	}
+	if {$@keynav} {
+		set @keynav 0
+		#bogus switch so that keynav remains the same next time..
+		if {$@keynav_tab_sel == "object"} {set @keynav_tab_sel "wire"} {set @keynav_tab_sel "object"}
+	}
+}
+
+#-----------------------------------------------------------------------------------#
+def Canvas keynav_current {} {return $@keynav_current}
+def Canvas keynav_current= {current} {
+	set @keynav_current $current
+	switch [$current class] {
+		Wire {set @keynav_last_wire $current}
+		default {set @keynav_last_obj $current}
+	}
+}
+def Canvas keynav {} {return $@keynav}
+def Canvas keyup {x y key iso shift} {
+	if {$iso != ""} {scan $iso %c key}
+	if {$::macro_state} {$::macro state= 1; set ::macro_state 0 }
+	$@active draw
+}
+
+class_new Active {View}
+def Active init {canvas} {
+	super
+	set @canvas $canvas
+	set @length 3
+	set @length2 10
+}
+def Active draw {} {
+	set current [$@canvas keynav_current]
+	if {$current == ""} {return}
+	if {![string compare $current 0]} {return}
+	set col [$self look selectframe]
+	if {[$@canvas keynav]} {
+		if {[$current class] == "Wire"} {
+			$self item_delete
+			set i 0
+			foreach side {1.6 -1.6} {
+				mset {ax1 ay1 ax2 ay2} [$current bbox]
+				set t [expr atan2($ay2-$ay1, $ax2-$ax1)]
+				set cx1 [expr $ax1 + (($ax2-$ax1)* 0.15)]
+				set cy1 [expr $ay1 + (($ay2-$ay1)* 0.15)]
+				set cx2 [expr ($@length * cos($t+$side)) + $cx1]
+				set cy2 [expr ($@length * sin($t+$side)) + $cy1]
+
+				for {set n 0} {$n < 2} {incr n} {
+					set angle [lindex {45 90 -45 -90} [expr $n+$i]]
+					mset {ax1 ay1 ax2 ay2} [$current bbox]
+					set t [expr atan2($ay2-$ay1, $ax2-$ax1)]
+					set bx1 [expr $ax1 + (($ax2-$ax1)* 0.15)]
+					set by1 [expr $ay1 + (($ay2-$ay1)* 0.15)]
+					set bx2 [expr ($@length2 * cos($t+$angle)) + $bx1]
+					set by2 [expr ($@length2 * sin($t+$angle)) + $by1]
+					set line [list $cx2 $cy2 $bx2 $by2]
+					$self item LINE$angle line $line -fill $col -width 2
+				}
+ 				set i [expr $i+2]
+			}
+		} else {
+			$self item_delete
+			mset {x y} [lmap - [$current xy] 5]
+			set line1 [list $x $y $x [expr $y + $@length2]]
+			set line2 [list $x $y [expr $x + $@length2] $y]
+			$self item LINE1 line $line1 -fill $col -width 2
+			$self item LINE2 line $line2 -fill $col -width 2
+
+		}
+	} else {$self hide}
+}
+def Active hide {} {$self item_delete}
+def Active bbox {} {
+	set current [$@canvas keynav_current]
+	set l [$current xy]
+	concat $l $l ;# happy now??
+}
+
+def Canvas update_Active {item} {$self keynav_current= $item}
+
+#-----------------------------------------------------------------------------------#
+class_new Box {View}
+
+def Box init {{mess {}}} {
+	super
+	# @wires2 stores the connections to and from a object
+	set @wires2 {}
+	$self reinit $mess
+}
+
+def Box delete {} {if {$@canvas != ""} {[$@canvas objects] unset $@index}; super}
+
+def Box remove_braces {str} {
+	# this hack is to remove the "\" in the text
+	regsub -all {\\} $str "" text
+	return $text
+}
+
+def Box reinit {mess} {
+    global classinfo fields
+	if {[$::macro state] && [llength $mess] > 4} {$::macro append_ref $mess}
+    if {![llength $mess]} {return} ;# what?
+    if {[lindex $mess 1] == "obj"} {set i 4} else {set i 1}
+    set @pdclass [lindex $mess $i]
+    if {[info exists fields($@pdclass)]} {
+	    set i 0
+	    foreach f $fields($@pdclass) {set _($self:$f) [lindex $mess $i]; incr i}
+    } else {
+	    set @text [$self remove_braces [join [lrange $mess 4 end]]]
+    }
+    $self outside_of_the_box
+}
+
+def Box update_size {} {}
+
+# will be so that @wires are updated correctly without breaking encapsulation
+def Box connect_out {} {}
+def Box connect_in {} {}
+
+def Box draw {} {
+	$self draw_box
+	if {[$@canvas show_id]} {$self draw_id} {$self item_delete ID}
+	[[$self get_canvas] widget] raise $self
+	$self update_hilite_io
+#	if {[$self class] == "Canvas"} {$self restack}
+	if {[info exists @elapsed]} {
+		mset {x1 y1 x2 y2} [$self bbox]
+		$self item ELAPSED text [l+ {10 1} [list $x1 $y2]] -anchor nw -fill "#008800" \
+			-text $@elapsed -font {{DejaVu Sans Mono} -8}
+	}
+}
+
+def Box elapsed {f} {
+	set @elapsed $f
+	$self changed
+}
+
+def Canvas get_elapsed {} {netsend [list .$self get_elapsed]}
+
+def Canvas show_id {} {return $@show_id}
+def Canvas show_id= {val} {set @show_id $val; $self redraw}
+def Canvas id_toggle {} {if {$@show_id} {set @show_id 0} {set @show_id 1}; $self redraw}
+
+def Box draw_id {} {
+	set id [$self index]:
+	mset {x y} [$self xy]
+	set fw [font measure [$self look font] 0]
+	if {[$@canvas editmode]} {
+		set col [complement [$@canvas look bgedit]]
+	} else {set col [complement [$@canvas look bgrun]]}
+	$self item ID text [list [expr $x-([string length $id]*$fw)] [expr $y+2]] \
+	    -font [$self look  font] -text $id \
+	    -fill $col -anchor nw
+}
+
+def Box draw_box {} {}
+def Box edit {} {}
+def Box unedit {} {}
+
+def Box bbox {} {
+	mset {x y} [$self xy]
+	set xs $@xs
+	set ys $@ys
+	list $x $y [expr {$x+$xs}] [expr {$y+$ys}]
+}
+
+def Box io_bbox {type port} {
+	mset {x1 y1 x2 y2} [$self bbox]
+	set xs [expr {$x2-$x1}]
+	# method calls aren't as fast as we'd want them to be.
+	#set iowidth [$self look iowidth]
+	#set fy [$self look iopos]
+	set iowidth 7
+	set fy -1
+	switch $type {
+		o {set n $@noutlets; set y [expr {$y2+$fy  }]}
+		i {set n  $@ninlets; set y [expr {$y1-$fy-1}]}
+	}
+	set nplus [expr {$n==1 ? 1 : $n-1}]
+	set onset [expr {$x1+($xs-$iowidth)*$port/$nplus}]
+	set points [list $onset $y [expr {$onset+$iowidth}] $y]
+	return $points
+}
+
+
+def Box ioselect= {type port} {set @ioselect [list $type $port]}
+def Box ioselect {} {return $@ioselect}
+
+def Box wires2 {} {return $@wires2}
+def Box wires2+= {val} {if {[lsearch $@wires2 $val] < 0} {lappend @wires2 $val}}
+
+def Box changed_wires {} {foreach wire $@wires2 {$wire changed}}
+
+def Box delete_wire {wire} {
+  set find [lsearch $@wires2 $wire]
+  if {$find != -1} {set @wires2 [lreplace $@wires2 $find $find]}
+}
+
+def Box move {dx dy} {
+	set @x1 [expr {$@x1+$dx}]; set @y1 [expr {$@y1+$dy}]
+	set zoom [$@canvas zoom]
+	$self changed ;# until we find a way to avoid rounding errors on [$@canvas widget] move.
+	$self changed_wires
+}
+
+# temporary hack... only used during the moving of objects.
+def Box backupxy= {xy} {set @backupxy $xy}
+def Box backupxy    {} {return $@backupxy}
+
+# the only one sending to the server.
+# View position= is when getting position from server.
+# View xy is virtual (for GOP)
+def Box moveto {x1 y1} {
+	netsend [list .$@canvas object_moveto $self $x1 $y1]
+	[$@canvas history] add [list $self moveto $@x1 $@y1]
+	if {[$self class] == "Canvas"} {
+		if {[$self gop] && ![winfo exists .$self.c]} {foreach x $@visibles {$x changed}}
+	}
+	set @x1 $x1
+	set @y1 $y1
+	$self changed
+	$self draw_wires
+}
+
+def Box draw_io2 {which n color} {
+	for {set i 0} {$i<$n} {incr i} {
+		set points [$self io_bbox $which $i]
+		$self item [list $which$i $which] rectangle $points -outline $color -fill $color -width 1
+		[[$self get_canvas] widget] raise $self$which$i
+	}
+}
+
+def Box draw_io {} {
+    $self draw_io2 i $@ninlets  [$self look inletfg]
+    $self draw_io2 o $@noutlets [$self look outletfg]
+}
+
+def Box tips= {tips} {set @tips $tips}
+
+def Box tip {type port} {
+	if {[info exists @tips]} {
+		set tips $@tips
+	} else {
+		netsend [list .$@canvas object_get_tips $self]
+		#after 500 $self tip $type $port
+		set tips ""
+	}
+	switch $type {
+		i {return "inlet $port: [lindex $tips $port]"}
+		o {return "outlet $port"}
+	}
+}
+
+# type is i or o
+def Box hilite_io {type x y} {
+	mset {x1 y1 x2 y2} [$self bbox]
+	set xs [expr $x2-$x1]
+	set c [$@canvas widget]
+	switch $type {i {set ports $@ninlets} o {set ports $@noutlets}}
+	set port -1
+	set iowidth [$self look iowidth]
+
+	for {set n 0} {$n<$ports} {incr n} {
+		set tag $self$type$n
+		set area [lmap / [$c bbox $self$type$n] [$@canvas zoom]]
+		set center [expr ([lindex $area 2] + [lindex $area 0]) / 2 ]
+		set dist [expr abs($x - $center)]
+		if {$dist < [expr ($iowidth/2)+5] && $dist > 0} {set port $n}
+	}
+
+	if {$ports==0 | $port==-1} return
+	if {$port >= $ports} {set port [expr $ports-1]}
+	$self hilite_io_2 $type $port
+	if {[$self look tooltip]} {$@canvas show_tooltip $x $y [$self tip $type $port] $type}
+	return $port
+}
+
+def Box update_hilite_io {} {
+	if {![llength $@ioselect]} {return}
+	set type [lindex $@ioselect 1]
+	set zoom [$@canvas zoom]
+	set port [lindex $@ioselect 0]
+	set p $type$port
+	$self hilite_io_2 $type $port
+}
+
+def Box hilite_io_2 {type port} {
+	set outline [switch $type {i {concat [$self look outletfg]} o {concat [$self look inletfg]}}]
+	set box [l+ [$self io_bbox $type $port] [list -3 -3 +3 +3]]
+	$self item $type${port}b rectangle $box -outline $outline -width 1
+}
+
+#def Box popup_help {} {netsend [list pd help $@pdclass]}
+def Box popup_help {} {netsend [list .$@canvas object_help $self]}
+
+def Box show_error {text} {
+	regsub "\n" $text "" text
+	#mset {x1 y1 x2 y2} [$self bbox]
+	#[$self get_canvas] show_tooltip [expr $x2+4] [expr ($y1+$y2)/2] $text object 1
+	mset {x1 y1 x2 y2} [$self bbox]
+	mset {x y} [rect_centre [$self io_bbox i 0]]
+	[$self get_canvas] show_tooltip $x $y $text i 1
+}
+
+def Canvas macro_event_append {e obj} {
+	if {![llength $@macro_q]} {after $@macro_delay [list $self macro_schedule $@macro_delay] $obj}
+	lappend @macro_q $e
+}
+
+def Canvas get_clipboard {obj} {
+	puts "get clipboard"
+	set content [clipboard get]
+	set l {}; set s ""; set space " ";
+	set last_newline [string last ";" $content]
+	#foreach char [split $content ""] {lappend l [scan $char %c]}
+	set i 0
+	foreach char [split $content ""] {
+		if {$i == $last_newline} {break}
+		#if {$char == ";"} {set s ${s}${space}list} {set s ${s}$char}
+		if {$char != ";"} {
+			if {$char == "\n"} {
+				set s ${s}${space}$char
+			} else {
+				set s ${s}$char
+			}
+		}
+		incr i
+	}
+	netsend [concat [list .$obj clipboard_set] $s]
+}
+
+
+def Canvas macro_schedule {delay obj} {
+	if {[llength $@macro_q]} {
+		set w [focus]
+		set m [lindex $@macro_q 0]
+		set fudge 0
+		mset {event x y mode k} $m
+		switch $event {
+			key {set name [modekey $k $mode]; set fudge 1}
+			click {set name [modeclick $k $mode ButtonPress]; set fudge 1}
+			unclick {set name [modeclick $k $mode ButtonRelease]; set fudge 1}
+			bang {
+				after $delay [list $self macro_schedule $@macro_delay] $obj
+				netsend [list .$obj mbang]
+				set @macro_q [lreplace $@macro_q 0 0]
+				return
+			}
+			default {puts "Error: this event $event should not have been here.."}
+		}
+		if {$fudge} {event generate $w <Motion> -x $x -y $y}
+		event generate $w <$name> -x $x -y $y
+		#puts "event generate $w <$name> -x $x -y $y"
+		if {$event=="key"} {event generate $w <KeyRelease-$k> -x $x -y $y}
+		set @macro_q [lreplace $@macro_q 0 0]
+		after $delay [list $self macro_schedule $@macro_delay] $obj
+	}
+}
+
+def Canvas foobar {} {$self macro_schedule 1000}
+
+def Canvas macro_q {} {puts "$@macro_q"}
+#-----------------------------------------------------------------------------------#
+class_new Wire {View}
+
+def Wire canvas= {c} {
+	super $c
+	mset {from outlet to inlet} $@connects
+	set children [$c objects]
+	set @from [$children get $from]
+	set   @to [$children get $to]
+	$@from wires2+= $self; $@to wires2+= $self
+}
+
+def  Box index= {i} {super $i; if {$@canvas != ""} {[$@canvas objects] set $i $self}}
+def Wire index= {i} {super $i;                      [$@canvas   wires] set $i $self }
+
+def Wire init {mess} {
+	super
+	$self reinit $mess
+}
+
+def Wire reinit {mess} {
+	if {[$::macro state]} {$::macro append_ref $mess}
+	mset {x msg from outlet to inlet canvas} $mess
+	set @connects [list $from $outlet $to $inlet]
+	set @outlet $outlet
+	set @inlet $inlet
+	$self outside_of_the_box
+}
+
+def Wire   from {} {return $@from}
+def Wire outlet {} {return $@outlet}
+def Wire     to {} {return $@to}
+def Wire  inlet {} {return $@inlet}
+def Wire move {dx dy} {$self changed}
+
+# DON'T do the former, it's so horribly slow
+#def View draw_wires {} {foreach wire $_($@canvas:wires) {$wire changed}}
+def View draw_wires {} {foreach wire $@wires2 {$wire changed}}
+
+def Wire bbox {} {
+	set from $@from; set outlet $@outlet
+	set   to $@to;   set  inlet  $@inlet
+	set zoom [$@canvas zoom]
+	set c [$@canvas widget]
+	mset {x1 y1} [lmap / [rect_centre [$c bbox ${from}o${outlet}]] $zoom]
+	mset {x2 y2} [lmap / [rect_centre [$c bbox   ${to}i${inlet} ]] $zoom]
+	list $x1 $y1 $x2 $y2
+}
+
+def Wire xy {} {
+	mset {x1 y1 x2 y2} [$self bbox]
+	list [expr $x1 + (($x2-$x1)*0.05)] [expr $y1 + (($y2-$y1)*0.05)]
+}
+
+def Wire report {} {list $@from $@outlet $@to $@inlet}
+def Wire connects {} {return $@connects}
+proc xys {x1 y1 x2 y2} {
+	return [list $x1 $y1 $x2 $y2] ;# just a straight line, no frills
+	set r {}
+	lappend r $x1 $y1
+	set dx [expr $x2-$x1]
+	set dy [expr $y2-$y1]
+	set d [expr sqrt($dx*$dx+$dy*$dy)]
+	set n [expr 1+$d/10]
+	for {set i 1} {$i<$n} {incr i} {
+		set w $i*($n-$i)/(0.0+$n*$n)
+		lappend r [expr $x1 + $dx*$i/$n + $dy*(rand()-0.5)*$w]
+		lappend r [expr $y1 + $dy*$i/$n - $dx*(rand()-0.5)*$w]
+	}
+	lappend r $x2 $y2
+	return $r
+}
+
+def Wire draw {} {
+	set zoom [$@canvas zoom]
+	set c [$@canvas widget]
+	set iowidth [$@from look iowidth]
+	mset {ox1 oy1 ox2 oy2} [$@from io_bbox o $@outlet]
+	mset {ix1 iy1 ix2 iy2} [  $@to io_bbox i $@inlet]
+	set x1 [expr ($ox1+$ox2)/2.0]; set y1 $oy2
+	set x2 [expr ($ix1+$ix2)/2.0]; set y2 $iy1
+	set xys [xys $x1 $y1 $x2 $y2]
+	set length [expr sqrt(pow($x2-$x1,2)+pow($y2-$y1,2))]
+	# how to customise the arrow size/shape?
+	set arrowsize [expr $length<100 ? $length/10 : 10]
+	if {$arrowsize < 5} {set arrow none} {set arrow last}
+	set arrowshape [list $arrowsize [expr $arrowsize*4/5] [expr $arrowsize/3]]
+	set wire_width [$self look thick]
+	set wire_color [$self look fg]
+	if {[$self selected?]} {
+	    set wire_color [$self look fg2] ;# fg2 should be renamed
+	} else {
+	    if {[info exists _($@from:text)] && [info exists _($@to:text)]} {
+		if {[regexp -nocase {~$} [lindex $_($@from:text) 0]] && \
+		    [regexp -nocase {~$} [lindex   $_($@to:text) 0]]} {
+			set wire_width [expr $wire_width*2]
+		}
+	    }
+	}
+	set options {}
+	if {[$self look wirearrow]} {lappend options -arrow $arrow -arrowshape $arrowshape}
+	eval [concat [list $self item WIRE line $xys -width $wire_width -smooth yes -fill $wire_color] $options]
+}
+
+def Wire delete {} {
+	$self unsubscribe $@canvas
+	$@from delete_wire $self
+	$@to   delete_wire $self
+	[$@canvas wires] unset $@index
+	super
+}
+
+def Wire popup_insert {} {
+	if {![llength [$@canvas selection_wire]]} {$@canvas selection_wire= $self}
+	mset {x y} [$@canvas insertxy]
+	$@canvas do_insert_obj $x $y
+}
+
+#-----------------------------------------------------------------------------------#
+############ colouring
+
+proc color_* {c1 c2} {
+	scan $c1 #%02x%02x%02x r g b
+	scan $c2 #%02x%02x%02x R G B
+	return [format #%02x%02x%02x [expr ($r*$R)>>8] [expr ($g*$G)>>8] [expr ($b*$B)>>8]]
+}
+
+# equivalent to color* #c0c0c0 $c
+proc darker {c} {
+	scan $c #%02x%02x%02x r g b
+	set r [expr $r*3/4]
+	set g [expr $g*3/4]
+	set b [expr $b*3/4]
+	return [format #%02x%02x%02x $r $g $b]
+}
+
+proc brighter {c} {
+	scan $c #%02x%02x%02x r g b
+	set r [min 255 [expr $r*4/3]]
+	set g [min 255 [expr $g*4/3]]
+	set b [min 255 [expr $b*4/3]]
+	return [format #%02x%02x%02x $r $g $b]
+}
+
+
+proc parse_color {c} {
+	regsub {;$} $c {} c
+	if {$c<0} {
+		set c [expr ~$c]
+		set r [expr round((($c>>12)&63)*255/63)]
+		set g [expr round((($c>> 6)&63)*255/63)]
+		set b [expr round((($c>> 0)&63)*255/63)]
+		return [format #%02x%02x%02x $r $g $b]
+	} {
+		global preset_colors2
+		return #[lindex $preset_colors2 $c]
+	}
+}
+
+proc unparse_color {c} {
+	if {[string index $c 0]=="#"} {set c [string replace $c 0 0 0x]}
+	set r [expr round((($c>>16)&255)*63/255)]
+	set g [expr round((($c>> 8)&255)*63/255)]
+	set b [expr round((($c>> 0)&255)*63/255)]
+	return [expr ~0[format %02o%02o%02o $r $g $b]]
+}
+
+############ data transfer
+# note: @pdclass is the server-side class name
+#  and   @_class is the client-side class name
+
+# abstract classes
+set fields1 {foo bar x1 y1 class}
+set fields2 {snd rcv lab ldx ldy fstyle fs bcol fcol lcol}
+
+# real classes
+set fields(tgl)    [eval list $fields1    w                  isa   $fields2 on nonzero]
+set fields(bng)    [eval list $fields1    w hold break       isa   $fields2]
+set fields(nbx)    [eval list $fields1    w h min max is_log isa   $fields2 val log_height]
+set fields(hsl)    [eval list $fields1    w h min max is_log isa   $fields2 val steady]
+set fields(hradio) [eval list $fields1    w change           isa n $fields2 on]
+set fields(vu)     [eval list $fields1    w h        rcv lab ldx ldy fstyle fs bcol lcol scale isa]
+set fields(cnv)    [eval list $fields1 hh w h    snd rcv lab ldx ldy fstyle fs bcol lcol       isa]
+set fields(dropper) [eval list $fields1 w isa $fields2]
+set fields(vsl)    $fields(hsl)
+set fields(vradio) $fields(hradio)
+set fields(hdl)    $fields(hradio)
+set fields(vdl)    $fields(hradio)
+set fields(coords)     {foo bar xfrom yfrom xto yto w h gop x1 y1} ;# goes with #N canvas
+set fields(floatatom)  {foo bar x1 y1 w min max pos lab rcv snd}
+set fields(symbolatom) {foo bar x1 y1 w min max pos lab rcv snd}
+set fields(array)      {name n elemtype flags}
+
+proc classinfo {pdclass _class} {
+	global classinfo classinfo2
+	set classinfo($pdclass) $_class
+	set classinfo2($_class) $pdclass
+}
+
+# basic patchables
+classinfo obj        ObjectBox
+classinfo message    MessageBox
+classinfo floatatom  FloatBox
+classinfo symbolatom SymbolBox
+classinfo text       Comment
+
+# non-patchables (scalars, arrays, ...)
+classinfo array    Array
+
+# GUI patchables
+classinfo bng      Bang
+classinfo tgl      Toggle
+classinfo nbx      NumBox
+classinfo hsl      Slider
+classinfo vsl      Slider
+classinfo vu       Vu
+classinfo dropper  Dropper
+classinfo hradio   Radio
+classinfo vradio   Radio
+classinfo hdl      Radio
+classinfo vdl      Radio
+classinfo canvas   Canvas
+classinfo cnv      Cnv
+classinfo display    Display
+
+# remember, _($foo:$bar) notation should die
+# because objects ought to be autonomous.
+
+# in array objects, number of inlets is bogus?
+#X array array1 1 float 3;
+#A 0 0;
+
+def View index= {i} {set @index $i}
+def View index {} {return $@index}
+
+proc change {self canvas index e {ninlets 0} {noutlets 0} {valid 1}} {
+	foreach mess [pd_mess_split $e] {change_2 $self $mess}
+	#the server ought to take care of this:
+	#if {[lindex $e 1] == "array"} {set ninlets 0; set noutlets 0}
+	if {$canvas != "x0"} {$self   canvas= $canvas}
+	$self    index= $index
+	$self  ninlets= $ninlets
+	$self noutlets= $noutlets
+	if {[$self class] == "ObjectBox"} {$self valid= $valid}
+	if {[$self class] == "Canvas"} {
+		if {[$self subpatch]} {$self valid= $valid}
+		if {[$self gop]} {$self valid= $valid}
+		if {[$self abs]} {$self valid= $valid}
+	}
+	$self changed
+}
+
+proc change_2 {self mess} {
+	set isnew [expr ![info exists ::_($self:_class)]]
+	switch -- [lindex $mess 0] {
+		"#N" {if {$isnew} {Canvas new_as $self $mess} else {$self reinit $mess}}
+		"#X" {
+			set i 1
+			# would it be possible to merge floatatom,symbolatom as gatom ?
+			switch -- [lindex $mess 1] {
+				obj        {set class [lindex $mess 4]}
+				msg        {set class message}
+				default    {set class [lindex $mess 1]}}
+			if {[info exists ::classinfo($class)]} {
+				set _class [lindex $::classinfo($class) 0]
+			} else {
+				if {[lindex $mess 1] == "connect"} {
+					set _class Wire
+				} else {
+					set _class ObjectBox
+				}
+			}
+			if {$isnew} {$_class new_as $self $mess} else {$self reinit $mess}
+			switch -- $class {
+				floatatom  {set class gatom}
+				symbolatom {set class gatom}
+				array {$self length= [lindex $mess 3]; $self name= [lindex $mess 2]}
+				default {$self position= [lrange $mess 2 3]}}
+			$self pdclass= $class
+		}
+		"#A" {
+			#post "#A: $mess"
+			$self array_set [lrange $mess 2 end]
+		}
+		"#V" {
+			#post "#V: $mess"
+		}
+		default {if {$mess != ""} {error "what you say? «[lindex $mess 0]» in «$mess»"}}
+	}
+}
+
+#proc pasting_count {self} {
+#	global paste _
+#	if {$paste(count2) != $paste(count)} {incr paste(count2)}
+#}
+
+# split at message boundaries and atom boundaries, returning a list of lists of atoms.
+# spaces    get  temporary value \x01
+# A_SEMI    gets temporary value \x02
+# backslash gets temporary value \x03
+# A_COMMA is not handled yet
+proc pd_mess_split {s} {
+	set s [regsub -all {\\\\} $s "\x03"]
+	set s [regsub -all {(^|[^\\]);}          $s "\\1\x02"]
+	set s [regsub -all {(^|[^\\])[\s\n]+}    $s "\\1\x01"]
+	set s [regsub -all {^\n}                 $s "\x01"] ;# oops
+	set s [regsub -all {\\([\\; \{\}])} $s "\\1\\2"]
+	set s [regsub -all \x03 $s \\]
+	set r {}
+	foreach m [split $s \x02] {
+		set m [regsub -all "\x01+" $m "\x01"]
+		set m [regsub -all "^\x01" $m ""]
+		set t [split $m \x01]
+		lappend r $t
+	}
+	return $r
+}
+
+proc canonical_list {list} {
+	set r {}
+	foreach e $list {lappend r $e}
+	return $r
+}
+
+proc pd_mess_split_want== {a b} {
+	set b [canonical_list $b]
+	set c [pd_mess_split $a]
+	if {[string compare $c $b]} {
+		puts "[VTred]string     «$a»\nparses to  «$c»\ninstead of «$b»[VTgrey]"
+	} else {
+		puts "[VTgreen]string     «$a» OK[VTgrey]"
+	}
+}
+
+if 0 {
+	pd_mess_split_want== {foo;bar;baz;a\;;b\\;c\\\;;d\\\\;e} {foo bar baz {{a;}} {b\\} {{c\;}} {{d\\}} e}
+	pd_mess_split_want== {foo\ bar} {{{foo bar}}}
+	pd_mess_split_want== {foo \  bar\ foo\ bar foo} {{foo { } {bar foo bar} foo}}
+	pd_mess_split_want== {\\ \\\\ \\\\\\ \ \\\ \\\\\ one} [list [list "\\" "\\\\" "\\\\\\" "\ \\\ \\\\\ one"]]
+	pd_mess_split_want== "\n  \n   \n  foo" foo
+	pd_mess_split_want== "\\\x7b\\\x7b\\\x7b\\\x7b" [list [list "\x7b\x7b\x7b\x7b"]]
+	pd_mess_split_want== "\\\x7d\\\x7d\\\x7d\\\x7d" [list [list "\x7d\x7d\x7d\x7d"]]
+	exit
+}
+
+############ rendering
+
+class_new MessageBox {TextBox}
+
+def MessageBox init {mess} {
+	super $mess
+	set @w 15 ;# this is useless?
+	set @xs $@w
+	set @ys $@w ;# this is a bug
+}
+
+def MessageBox draw_box {} {
+	mset {x1 y1} [$self xy]
+	set x2 [expr $x1+$@xs]
+	set y2 [expr $y1+$@ys]
+	set points [list $x1 $y1 [expr $x2+4] $y1 $x2 [expr $y1+4] $x2 [expr $y2-4] [expr $x2+4] $y2 $x1 $y2 $x2 $y2 $x1 $y2]
+	if {[$self selected?]} {set frcol [$self look selectframe]} {set frcol [$self look frame3]}
+	$self item BASE polygon $points -fill [$self look bg] -outline $frcol -width 1
+	[$@canvas widget] lower ${self}BASE ${self}TEXT
+	[$@canvas widget] raise $self
+}
+
+def MessageBox draw {} {
+	super
+	$self draw_io
+}
+
+def MessageBox click {x y f target} {
+	$self bang 1
+	netsend [list .$self bang]
+	after 150 $self bang 0
+}
+
+def MessageBox bang {flag} {
+	if {$flag} {set color #ffff00} {set color [$self look bg]}
+	[$@canvas widget] itemconfigure ${self}BASE -fill $color
+}
+
+# it was class_new AtomBox {View Box}, which is wrong because already Box<View
+# it shouldn't have mattered, but super doesn't support proper pruning yet
+#class_new AtomBox {Box}
+class_new AtomBox {TextBox}
+def AtomBox draw_box {} {
+	$self update_size
+	mset {x1 y1 x2 y2} [$self bbox]
+	set points [list $x1 $y1 [expr $x2-4] $y1 $x2 [expr $y1+4] $x2 $y2 $x1 $y2]
+	if {[$self selected?]} {set frcol [$self look selectframe]} {set frcol [$self look frame3]}
+	$self item BASE polygon $points -fill [$self look bg] -outline $frcol
+	[[$self get_canvas] widget] lower ${self}BASE ${self}TEXT
+	$self draw_io
+}
+
+def AtomBox clear {var} {set @clear $var}
+def AtomBox clear= {} {return $@clear}
+
+def AtomBox filter_text {{for_edit 0}} {
+	if {$for_edit} {return ""}
+	if {[string length $@text] <= $@w} {return $@text}
+	return [string range $@text 0 [expr $@w-1]]
+}
+
+def AtomBox update_size {} {
+	set width [font measure [$self look font] 0]
+	set ls [font metrics [$self look font] -linespace]
+	set @xs [expr ($width*$@w)+3]
+	set @ys [expr $ls+3]
+}
+
+class_new Comment {TextBox}
+
+def Comment draw_box {} {
+	super
+        mset {x1 y1} [$self xy]
+	set x2 [expr $x1+$@xs]
+        set y2 [expr $y1+$@ys]
+        set xya [list $x1 $y1 $x2 $y2]
+	set xyb [l+ [list $x2 $y1 $x1 $y1 $x1 $y2] [list -1 +1 +1 +1 +1 -1]]
+	set xyc [l+ [list $x2 $y1 $x2 $y2 $x1 $y2] [list -1 +1 -1 -1 +1 -1]]
+	if {[$@canvas editmode]} {
+		if {[$self selected?]} {set frcol [$self look selectframe]} {set frcol [$self look frame3]}
+		$self item BASE  rectangle $xya -fill [$self look bg] -outline $frcol
+	} else {
+		$self item_delete BASE
+	}
+	#$self item BASE1 line      $xyb -fill [$self look frame1]
+	#$self item BASE2 line      $xyc -fill [$self look frame2]
+	if {[$@canvas editmode]} {
+		[$@canvas widget] lower ${self}BASE ${self}TEXT
+		#[$@canvas widget] raise ${self}BASE1 ${self}BASE
+		#[$@canvas widget] raise ${self}BASE2 ${self}BASE
+	}
+}
+
+class_new Display {Box}
+
+def Display height= {val} {set @height $val}
+
+def Display init {{mess {}}} {
+	set font [$self look font]
+	set fw [font measure $font 0]
+	set @max_width 40; #in chars
+	set @wrap [expr $fw*$@max_width]; #in pixels
+	set @content {display}
+	set @height 1
+	set @xs [expr [font measure [$self look font] 0]+3]
+	set @ys [font metrics [$self look font] -linespace]
+	set @textoffset [list 2 2]
+	netsend [list .$self height]
+	super $mess
+}
+
+def Display draw {} {
+	super
+	set font [$self look font]
+	mset {x y} [$self xy]
+	mset {xf yf} $@textoffset
+	set fh [font metrics [$self look font] -linespace]
+	set text [lindex $@content 0];
+	for {set i 1} {$i < $@height} {incr i} {set text ${text}\n[lindex $@content $i]}
+	set h 0; set w 0
+	foreach line $@content {
+		set tw [font measure $font $line]
+		set h [expr int(ceil($tw/$@wrap.0)+$h)]
+		set w [min [max $w $tw] $@wrap]
+	}
+	set h [max $h 1]
+	$self item BASE rect [list $x $y [expr $x+$w+$xf+2] [expr $y+($@ys*$h)+$yf+1]] \
+	    -fill [$self look bg]
+
+	$self item TEXT text [l+ $@textoffset [$self xy]] -font $font -text $text \
+	    -fill [$self look fg] -anchor nw -width $@wrap
+	$self draw_io
+}
+
+def Display dis {text} {
+	lappend @content $text
+	if {[llength $@content] > $@height} {set @content [lrange $@content 1 end]}
+	$self changed
+}
+
+class_new IEMGUI {}
+def IEMGUI text {} {
+	return [$self class]
+}
+class_new BlueBox {Labelled IEMGUI Box}
+#class_new BlueBox {Box Labelled}
+
+def BlueBox draw_box {} {
+	super
+	set xya [$self bbox]
+	mset {x1 y1 x2 y2} $xya
+	set xyb [list [expr $x2-1] [expr $y1+1] [expr $x1+1] [expr $y1+1] [expr $x1+1] [expr $y2-1]]
+	set xyc [list [expr $x2-1] [expr $y1+1] [expr $x2-1] [expr $y2-1] [expr $x1+1] [expr $y2-1]]
+	set color [color_* [$self look bg] [parse_color $@bcol]]
+	if {[$self selected?]} {set frcol [$self look selectframe]} {set frcol [$self look frame3]}
+	$self item BASE  rectangle $xya -fill $color -outline $frcol
+	#below lines draws the 3d box edge
+	#$self item BASE2 line      $xyb -fill #ffffff
+	#$self item BASE3 line      $xyc -fill [darker $color]
+	$self draw_io
+}
+
+def IEMGUI popup_properties {} {IEMPropertiesDialog new $self}
+
+class_new PropertiesDialog {Dialog}
+
+def PropertiesDialog init {of} {
+	super cancel apply ok
+	set @of $of
+	set f .$self
+	checkbutton $f.auto_apply -text [say auto_apply] -anchor w -variable @auto_apply
+	frame $f.buttonsep2 -height 2 -borderwidth 1 -relief sunken
+	pack $f.auto_apply $f.buttonsep2 -side bottom -fill x
+	bind $f <KeyPress-Return> "break";#so that Return don't call do_auto_apply after Dialog ok
+	bind $f <KeyPress>        [list $self do_auto_apply]
+	bind $f <ButtonRelease>   [list $self do_auto_apply]
+	set @auto_apply 0
+	$self none_resizable
+}
+
+def PropertiesDialog do_auto_apply {} {
+	if {$@auto_apply} {$self apply}
+}
+
+class_new IEMPropertiesDialog {PropertiesDialog}
+
+def IEMGUI properties_apply {list {orient -1}} {
+	set orig [list $self properties_apply]
+	foreach var [lrange $::fields($@class) 5 end] {lappend orig $@$var}
+	[$@canvas history] add $orig
+	foreach v $list {switch -- $v {{} {set v "empty"}}; lappend props $v}
+	netsend [concat [list .$self reload] $props]
+	if {$orient >= 0} {
+		netsend [list .$self orient $orient]
+	}
+}
+
+def IEMPropertiesDialog apply {} {
+	set class $_($@of:class)
+	set props {}
+	foreach var [lrange $::fields($class) 5 end] {
+		set v $@$var
+		if {[regexp -nocase {^[bfl]col$} $var]} {set v [unparse_color $v]}
+		lappend props $v
+	}
+	if {[[$@of class] <= Slider] || [[$@of class] <= Radio]} {
+		$@of properties_apply $props $@orient
+	} else {
+		$@of properties_apply $props
+	}
+}
+
+def IEMPropertiesDialog init {of} {
+	super $of
+	set @class $_($of:class)
+	wm title .$self "\[$@class\] [say popup_properties]"
+	if {![info exists ::fields($@class)]} {set class obj}
+	foreach var $::fields($@class) {
+		set val $_($of:$var)
+		switch -- $val { empty {set val ""}}
+		if {[regexp -nocase {^([a-z])col$} $var]} {set val [parse_color $val]}
+		set @$var $val
+	}
+	if {[[$of class] <= Slider] || [[$of class] <= Radio]} {
+		set @orient $_($of:orient)
+		$self add .$self [list orient choice -choices {horizontal vertical}]
+	}
+	foreach prop [lrange $::fields($@class) 5 end] {
+		set d [concat [list $prop] [switch $prop {
+			w      {list integer -width 7}
+			h      {list integer -width 7}
+			hold   {list float   -width 9}
+			break  {list float   -width 9}
+			min    {list float   -width 9}
+			max    {list float   -width 9}
+			is_log {list choice  -choices {linear logarithmic}}
+			isa    {list choice  -choices {no yes}}
+			n      {list integer -width 4}
+			steady {list choice  -choices {steady_no steady_yes}}
+			snd    {list entry   -width 20}
+			rcv    {list entry   -width 20}
+			lab    {list entry   -width 20}
+			ldx    {list integer -width 5}
+			ldy    {list integer -width 5}
+			fstyle {list choice  -choices {Courier Helvetica Times}}
+			fs     {list fontsize -width 5}
+			bcol   {list color}
+			fcol   {list color}
+			lcol   {list color}
+			val    {continue}
+			on     {continue}
+			change {list choice -choices {no yes}}
+			nonzero {list float -width 9}
+			log_height {list float -width 9}
+			hh {continue}
+			scale {list toggle}
+			default {error "huh? ($prop)"}
+		}]]
+		$self add .$self $d
+	}
+}
+
+def IEMPropertiesDialog dropmenu_open {f name} {super $f}
+def IEMPropertiesDialog dropmenu_set {frame var part val} {
+	switch $var {
+		orient {if {[$@of class] == "Slider"} {set tmp $@h; set @h $@w; set @w $tmp}}
+		default {}
+	}
+	set tmp ${var}choices
+	set textvar ${var}2
+	set @$textvar [say [lindex $@$tmp $val]]
+	super $frame $var $part $val
+	$self do_auto_apply
+}
+
+class_new CanvasPropertiesDialog {PropertiesDialog}
+
+def CanvasPropertiesDialog init {of} {
+	super $of
+	set @canvas $of
+	wm title .$self "[say canvas] [say popup_properties]"
+	set @gop [$of gop]
+	set @properties [list "gop" "xfrom" "xto" "yfrom" "yto" "width" "height" "xmargin" "ymargin"]
+	set mess [$of get_mess]
+	mset [list @xfrom @yfrom @xto @yto @width @height @xmargin @ymargin] $mess
+	if {!$@width} {set @width 85}; if {!$@height} {set @height 60}
+	$self add .$self [list gop toggle -command "$self gop_setting"]
+	for {set i 1} {$i<[llength $@properties]} {incr i} {
+		$self add .$self [list [lindex $@properties $i] integer -width 7]
+	}
+	$self gop_setting
+}
+
+def CanvasPropertiesDialog gop_setting {} {
+	set entries [lrange $@properties 1 end]
+	foreach entry $entries {
+		if {!$@gop} {
+			.$self.$entry.entry configure -state disable
+		} else {
+			.$self.$entry.entry configure -state normal
+		}
+	}
+}
+
+def CanvasPropertiesDialog apply {} {
+	if {![$@canvas editmode]} {$@canvas editmode= 1}
+	netsend [list .$@of coords $@xfrom $@yfrom $@xto $@yto $@width $@height $@gop $@xmargin $@ymargin]
+}
+
+proc gatom_escape {sym} {
+	if {[string length $sym] == 0} {return "-"}
+	if {[string equal -length 1 $sym "-"]} {return [string replace $sym 0 0 "--"]}
+	return $sym
+}
+
+proc gatom_unescape {sym} {
+	if {[string equal -length 1 $sym "-"]} {return [string replace $sym 0 0 ""]}
+	return $sym
+}
+
+class_new BoxPropertiesDialog {PropertiesDialog}
+def Box popup_properties {} {BoxPropertiesDialog new $self}
+def Box popup_clear_wires {} {[$self canvas] selection= $self; [$self canvas] clear_wires}
+def Box popup_remove_from_path {}   {[$self canvas] selection= $self; [$self canvas] remove_obj_from_path}
+def Box popup_delete_from_path {}   {[$self canvas] selection= $self; [$self canvas] delete_obj_from_path}
+def BoxPropertiesDialog init {of} {
+	super $of
+	wm title .$self "Box Properties"
+	pack [label .$self.huh  -text "huh..."]
+	pack [label .$self.huh2 -text "this is where some #V properties should go"]
+}
+
+class_new WirePropertiesDialog {PropertiesDialog}
+def Wire popup_properties {} {WirePropertiesDialog new $self}
+def WirePropertiesDialog init {of} {
+	super $of
+	wm title .$self "Wire Properties"
+	pack [label .$self.huh  -text "huh..."]
+	pack [label .$self.huh2 -text "this is where some #V properties should go"]
+}
+
+class_new GAtomPropertiesDialog {PropertiesDialog}
+
+def AtomBox popup_properties {} {GAtomPropertiesDialog new $self}
+
+# this is buggy due to miller's escapes vs iem's escapes.
+def GAtomPropertiesDialog apply {} {
+	netsend [list .$@of reload $@w $@min $@max $@pos [gatom_escape $@lab] [gatom_escape $@rcv] [gatom_escape $@snd]]
+}
+
+def GAtomPropertiesDialog init {of} {
+	super $of
+	foreach var {w min max pos} {set @$var $_($of:$var)}
+	foreach var {lab rcv snd} {set @$var [gatom_unescape $_($of:$var)]}
+	wm title .$self "Atom"
+	global properties
+	$self add .$self \
+	    {w   entry -width 4} \
+	    {min entry -width 8} \
+	    {max entry -width 8} \
+	    {lab entry -width 20} \
+	    {pos side} \
+	    {snd entry -width 20} \
+	    {rcv entry -width 20}
+	#foreach name {w min max} {bind .$self.$name.entry <KeyPress-Return> "$self ok"}
+	.$self.w.entry select from 0
+	.$self.w.entry select adjust end
+	focus .$self.w.entry
+}
+
+class_new GraphPropertiesDialog {Dialog}
+
+def GraphPropertiesDialog apply {} {
+	netsend [list .$@of dialog $@x1 $@y1 $@x2 $@y2 $@xpix $@ypix]
+}
+
+def GraphPropertiesDialog init {of} {
+	super $of
+	foreach var {x1 y1 x2 y2 xpix ypix} {set @$var $_($of:$var)}
+	wm title .$self "Graph"
+	pack [label .$self.label -text "GRAPH BOUNDS"] -side top
+	global properties
+	$self add .$self {
+		{x1   entry -width 7} \
+		{x2   entry -width 7} \
+		{xpix entry -width 7} \
+		{y2   entry -width 7} \
+		{y1   entry -width 7} \
+		{ypix entry -width 7}
+	}
+	#.$self.xrangef.x2 select from 0
+	#.$self.xrangef.x2 select adjust end
+	#focus .$self.xrangef.x2
+}
+
+class_new ArrayPropertiesDialog {Dialog}
+
+def ArrayPropertiesDialog apply {} {
+	regsub {^\$} $@name "#" name
+	netsend [list .$@apply arraydialog $name $@n $@saveit $@otherflag]
+}
+
+def ArrayPropertiesDialog init {of} {
+	super $of
+	foreach var {name n saveit} {set @$var $_($of:$var)}
+	set @otherflag 0
+	wm title $id "[say array] [say popup_properties]"
+	$self add .$self {name entry} {n entry}
+	pack [checkbutton .$self.saveme -text "save contents" -variable @saveit -anchor w] -side top
+	if {$newone != 0} {
+		pack [frame .$self.radio] -side top
+		foreach {i label} {0 "in new graph" 1 "in last graph"} {
+			pack [radiobutton .$self.radio.radio$i -value $i -variable @otherflag -text $label] -side top -anchor w
+		}
+	} else {
+		pack [checkbutton .$self.deleteme -text "delete me" -variable @otherflag -anchor w] -side top
+	}
+	if {$newone} {.$self.buttonframe.apply configure -state disabled}
+	bind .$self.name.entry <KeyPress-Return> "$self ok"
+	bind .$self.n.entry    <KeyPress-Return> "$self ok"
+	.$self.name.entry select from 0
+	.$self.name.entry select adjust end
+	focus .$self.name.entry
+}
+
+class_new FloatBox  {AtomBox}
+class_new SymbolBox {AtomBox}
+
+def AtomBox init {mess} {
+	super $mess
+	set @clickpos {}
+	set width [font measure [$self look font] W]
+	set height [font metrics [$self look font] -linespace]
+	set @xs [expr ($width*$@w)+3]
+	set @ys [expr $height+3]
+}
+
+def FloatBox  init {mess} {super $mess; set @text 0;}
+
+def FloatBox calc {x y x1 y1} {
+	#puts "$@min $@max"
+	if {!$@min && !$@max} {
+		set d [expr $@ovalue+($y1-$y)*$@rate]
+	} else {
+		set span [expr $@max-$@min]
+		set l [expr $@max-$@min]
+		set d [clip [expr $@ovalue+(($y1-$y)*$span/($l+0.0))*$@rate] $@min $@max]
+	}
+	return $d
+}
+
+def SymbolBox init {mess} {super $mess; set @text "symbol"}
+
+def AtomBox set {val} {set @text [format "%g" $val]; $self changed}
+
+def AtomBox setto {text} {
+	[$@canvas widget] configure -cursor {}
+	if { [string is double $text]} {
+		set @text $text; #so that the text gets updated immediately
+		netsend [list .$self float  $text]
+		#[$self get_canvas] selection-= $self
+	}
+}
+def SymbolBox set {text} {set @text $text}
+def SymbolBox setto {text} {
+	[$@canvas widget] configure -cursor {}
+	if {![string is double $text]} {netsend [list .$self symbol $text]}
+}
+
+def FloatBox ftoa {} {
+	set f $@val
+	set is_exp 0
+	if {[string length $@buf]>0} {return $@buf}
+	set buf [format %g $f]
+	set bufsize [string length buf]
+	if {$bufsize >= 5} {
+		# exponential mode
+		set is_exp [regexp -nocase e]
+	}
+	if {$bufsize > $@w} {
+		# must shrink number
+		if {$is_exp} {
+			#...
+		} {
+			#...
+		}
+	}
+	return $buf
+}
+
+def AtomBox click {x y f target} {
+	set @clickx $x; set @clicky $y
+	set canvas [$self get_canvas]
+	set t [$canvas widget].${self}text
+	set @ovalue [clip $@text $@min $@max]
+	set @clickpos [list $x $y]
+	set @mouse [list $x $y]
+	$canvas focus= $self
+	set @rate [expr $f&1 ? 0.01 : 1.00]
+}
+
+def AtomBox unclick {x y f target} {
+	if {$x == $@clickx && $y == $@clicky} {$self edit}
+	[$self get_canvas] focus= ""
+}
+
+def AtomBox motion {x y f target} {
+	if {$@edit} {return}
+	mset {clx cly} $@clickpos
+	set @text [$self calc $x $y $clx $cly]
+	netsend [list .$self float [expr {0+$@text}]]
+}
+
+def AtomBox log_ratio {} {
+	set diff [expr $@is_log ? log($@max/$@min) : ($@max-$@min)]
+	return [expr $diff / $@max]
+}
+
+def AtomBox key_incr {val1 val2} {
+	set @text [expr $@text - $val2]
+	netsend [list .$self float [expr {0+$@text}]]
+}
+
+def SymbolBox motion {x y f target} {}
+class_new NumBox {Labelled IEMGUI AtomBox}
+
+def NumBox init {mess} {
+	super $mess
+	set @clicking 0
+	set changed 0
+	set @buf ""
+	set @text [clip 0 $@min $@max]
+}
+
+def NumBox calc {x y x1 y1} {
+	set span [expr $@max-$@min]
+	set l [expr $@is_log ? $@log_height : ($@max-$@min)]
+	set d [expr {($y1-$y)*$span/($l+0.0)}]
+	set d [expr $@is_log ? $@ovalue*exp($d*$@rate*[$self log_ratio]) : $@ovalue+$d*$@rate]
+	set d [clip $d $@min $@max]
+	return $d
+}
+
+
+def NumBox reinit {mess} {
+	super $mess
+	set @text $@val
+}
+
+def NumBox draw {} {
+	super
+	mset {x1 y1} [$self xy]
+	set xs [expr 4+10*$@w]
+	set ys $@h
+	set x2 [expr $x1+$xs]
+	set y2 [expr $y1+$ys]
+	set c [[$self get_canvas] widget]
+	set points [list $x1 $y1 [expr $x2-4] $y1 $x2 [expr $y1+4] $x2 $y2 $x1 $y2]
+	set xt [expr $x1+$ys/2+2]
+	set yt [expr $y1+$ys/2+1+$xs/34]
+	set points2 [list $x1 $y1 [expr $x1+$ys/2] [expr $y1+$ys/2] $x1 $y2]
+	set focused [$self == [$@canvas focus]]
+	if {$focused} {set color4 #00ff00} {set color4 [$self look bg]}
+	$self item BASE4  polygon $points2 -outline [$self look frame3] -fill $color4
+	$c raise ${self}BASE4
+}
+
+def NumBox ftoa {} {
+	set f $@text
+	set is_exp 0
+	if {[string length $@buf]>0} {return $@buf}
+	set buf [format %g $f]
+	set bufsize [string length buf]
+	if {$bufsize >= 5} {
+		# exponential mode
+		set is_exp [regexp -nocase e]
+	}
+	if {$bufsize > $@w} {
+		# must shrink number
+		if {$is_exp} {
+			#...
+		} {
+			#...
+		}
+	}
+	return $buf
+}
+
+def NumBox unfocus {} {set @buf ""; $self changed}
+
+class_new Radio {BlueBox}
+
+def Radio reinit {mess} {
+	super $mess
+	switch [lindex $mess 4] {
+		hradio {set @orient 0} hdl {set @orient 0}
+		vradio {set @orient 1} vdl {set @orient 1}
+		default {set @orient 0}
+	}
+}
+
+def Radio bbox {} {
+	mset {x1 y1} [$self xy]
+	set x2 [expr $x1+$@w*($@orient ?1:$@n)]
+	set y2 [expr $y1+$@w*($@orient ?$@n:1)]
+	list $x1 $y1 $x2 $y2
+}
+
+def Radio draw {} {
+	mset {x1 y1 x2 y2} [$self bbox]
+	super
+	for {set i 0} {$i<$@n} {incr i} {
+		$self item [list BUT$i BUT] rectangle \
+		    [list [expr $x1+3] [expr $y1+3] [expr $x1+$@w-3] [expr $y1+$@w-3]] \
+		    -fill #ffffff -outline #000000
+		if {$@orient} {set y1 [expr $y1+$@w]} {set x1 [expr $x1+$@w]}
+	}
+	$self set $@on
+}
+
+def Radio set {value} {
+	set c [$self get_canvas]
+	[$c widget] itemconfigure ${self}BUT       -fill #ffffff
+	[$c widget] itemconfigure ${self}BUT$value -fill #000000
+}
+
+def Radio click {x y f target} {
+	mset {x1 y1} [$self xy]
+	set i [expr {($@orient ?$y-$y1:$x-$x1)/$@w}]
+	netsend [list .$self fout $i]
+}
+
+def Radio key_incr {val1 val2} {
+	netsend [list .$self fout [expr $@on - $val2]]
+}
+
+class_new Slider {BlueBox}
+
+# in sliders, @value is the kind of value that goes thru inlets and outlets
+# whereas @val is always measured in "centipixels" (unzoomed).
+def Slider reinit {mess} {
+	super $mess
+	set @knob_thick 4
+	switch [lindex $mess 4] {
+		hsl {set @orient 0}
+		vsl {set @orient 1}
+	}
+	$self update_value
+}
+
+def Slider update_value {} {
+	set span [expr {$@max-$@min}]
+	set l [expr $@orient ?$@h:$@w]
+	set @value [expr $@val*$span/($l-1)/100]
+	#set t [expr $@val * [$self slider_ratio] * 0.01]
+	#set @value [expr $@min*exp($t)]
+}
+
+def Slider init {mess} {
+	super $mess
+	set @oposition $@min
+	$self update_value
+}
+
+def Slider bbox {} {
+	mset {x1 y1} [$self xy]
+	if {!$@orient} {
+		list $x1 $y1 [expr $x1+$@w+$@knob_thick] [expr $y1+$@h]
+	} else {
+		list $x1 [expr $y1-$@knob_thick] [expr $x1+$@w] [expr $y1+$@h]
+	}
+}
+
+#the value/centipixel ratio
+def Slider slider_ratio {} {
+	set diff [expr $@is_log ? log($@max/$@min) : ($@max-$@min)]
+	return [expr $diff / ($@orient ? ($@h-1) : ($@w-1))]
+}
+
+def Slider draw_knob {} {
+	mset {x1 y1 x2 y2} [$self bbox]
+	set l [expr $@orient ?$@h:$@w]
+	set span [expr {$@max-$@min}]
+	set color [$self look bg]
+	set scaled [expr {$@value*($l-1)/$span}]
+	set thick [expr $@knob_thick/2]
+	if {$@orient} {
+		set y1 [expr $y1+$@knob_thick]
+		set y [expr $y1+$@h-$scaled-2]
+		set coords [list [expr $x1+2] $y [expr $x1+$@w-2] [expr $y-2]]
+	} else {
+		set x2 [expr $x1-$@knob_thick]
+		set x [expr $x1+$scaled]
+		set coords [list $x [expr $y1+$thick] [expr $x+2] [expr $y1+$@h-$thick]]
+	}
+	$self item KNOB rectangle $coords -outline red -fill [darker $color]
+}
+
+def Slider draw {} {
+	mset {x1 y1 x2 y2} [$self bbox]
+	#if {$@orient} {set y1 [expr $y1-2]} {set x1 [expr $x1-2]}
+	#if {$@orient} {set ys [expr $@h+5]} {set xs [expr $@w+5]}
+	super
+	$self draw_knob
+	$self update_value
+}
+
+# not used
+def Slider draw_notches {} {
+	if {$@orient} {
+		set thick [clip [expr $xs/3] 1 5]
+		set x3 [expr $x1+$xs-$thick/2-2]
+		set eighth [expr round($ys/8-1)]
+		set coords [list $x3 $y1 $x3 [expr $y1+$ys]]
+	} else {
+		set thick [clip [expr $ys/3] 1 5]
+		set y3 [expr $y1+$ys-$thick/2-2]
+		set eighth [expr $xs/8]
+		set coords [list $x1 $y3 [expr $x1+$xs] $y3]
+	}
+	# there were supposed to be 7 notches... i don't remember what happened here.
+	$@canvas item NOTCH $coords -dash [list 1 $eighth 1 $eighth] -width $thick -fill [darker [$self look bg]]
+}
+
+def Slider click {x y f target} {
+	set canvas [$self get_canvas]
+	mset {type id detail} [$canvas identify_target $x $y $f]
+	if {$type == "label"} {return}
+	$canvas focus= $self
+	set @click_at [list $x $y]
+	set @rate [expr $f&1 ? 0.01 : 1.00]
+	if {!$@steady} {
+		mset {x1 y1 x2 y2} [$self bbox]
+		set t [expr [$self calc $x $y $x1 $y2]*$@rate]
+		set @value [expr $@is_log ? [expr $@min*exp($t*[$self slider_ratio])] : $t]
+		set @oposition $t
+		netsend [list .$self float $@value]
+	} else {set @oposition $@value}
+}
+
+def Slider unclick {x y f target} {
+	### keep focus if only clicked. do we want that feature?
+	# if {[distance $@click_at [list $x $y]] == 0} {return}
+	set canvas [$self get_canvas]
+	$canvas focus= ""
+}
+
+def Slider motion {x y f target} {
+	set canvas [$self get_canvas]
+	set focused [$self == [$canvas focus]]
+	if {!$focused} {return}
+	mset {clx cly} $@click_at
+	set d [$self calc $x $y $clx $cly]
+	set t ($@oposition+$d*$@rate)
+	set value [expr $@is_log ? [expr $@min*exp($t*[$self slider_ratio])] : $t]
+	set out [clip $value $@min $@max]
+	netsend [list .$self float $out]
+}
+
+def Slider key_incr {val1 val2} {
+	set @value [expr $@value - $val2]
+	netsend [list .$self float $@value]
+}
+
+def Slider calc {x y x1 y1} {
+	set span [expr $@max-$@min]
+	set l [expr {$@orient ?$@h:$@w}]
+	set d [expr {($@orient ?$y1-$y:$x-$x1)*$span/($l+0.0)}]
+	return $d
+}
+
+def Slider unfocus {} {$self draw}
+
+class_new Labelled {}
+
+def Labelled draw {} {
+	global leet
+	super
+	mset {x1 y1} [$self xy]
+	set lx [expr $x1+$@ldx]
+	set ly [expr $y1+$@ldy]
+	set label $@lab; switch -- $label { empty { set label "" }}
+	set lfont [list [lindex {courier helvetica times} $@fstyle] $@fs bold]
+	set lcolor [parse_color $@lcol]
+	if {$leet} {
+		    set text [string map -nocase {a 4 e 3 t 7 s 5 i 1 o 0 g 9} $label]
+	    } else {
+		    set text $label
+	    }
+	$self item LABEL text [list $lx $ly] -text $text -anchor w -font $lfont -fill $lcolor
+}
+#-----------------------------------------------------------------------------------#
+class_new Bang {BlueBox}
+def Bang init {mess} {
+	super $mess
+	set @flash 0
+	set @count 0
+}
+
+def Bang bbox {} {
+	mset {x1 y1} [$self xy]
+	list $x1 $y1 [expr $x1+$@w] [expr $y1+$@w]
+}
+
+def Bang draw {} {
+	super
+	mset {x1 y1 x2 y2} [$self bbox]
+	if {$@flash} {
+		set rect [list [expr $x1+2] [expr $y1+2] [expr $x2-2] [expr $y2-2]]
+		#$self item BUT oval $rect -fill [color_* [$self look bg] [parse_color $@fcol]]
+		set fcol [color_* [$self look bg] [parse_color $@fcol]]
+		set bcol [color_* [$self look bg] [parse_color $@bcol]]
+		$self item BUT oval $rect -fill $fcol
+		after 100 [list $self item BUT oval $rect -fill $bcol]
+		set @flash 0
+	} else {
+		set colour [parse_color $@bcol]
+		set rect [list [expr $x1+2] [expr $y1+2] [expr $x2-2] [expr $y2-2]]
+		$self item BUT oval $rect -fill [color_* [$self look bg] $colour] -outline [$self look frame3]
+	}
+}
+def Bang unclick {x y f target} {}
+def Bang click   {x y f target} {netsend [list .$self bang]}
+def Bang bang {count} {set @count $count; set @flash 1}
+def Bang key_incr {val1 val2} {netsend [list .$self bang]}
+
+class_new Toggle {BlueBox}
+
+def Toggle bbox {} {
+	mset {x1 y1} [$self xy]
+	list $x1 $y1 [expr $x1+$@w] [expr $y1+$@w]
+}
+
+def Toggle draw {} {
+	super
+	mset {x1 y1 x2 y2} [$self bbox]
+	set colour [parse_color $@bcol]
+	set t [expr int(($@w+29)/30)]
+	set fill [color_* [$self look bg] $colour]
+	set x3 [expr $x1+$t+2]; set y3 [expr $y1+$t+2]
+	set x4 [expr $x2-$t-2]; set y4 [expr $y2-$t-2]
+	if {$@on} {
+		set fill [parse_color $@fcol]
+	} {
+		set fill [color_* [$self look bg] [parse_color $@bcol]]
+	}
+	$self item X1 line [list $x3 $y3 [expr $x4+1] [expr $y4+1]] -width $t -fill $fill
+	$self item X2 line [list $x3 $y4 [expr $x4+1] [expr $y3-1]] -width $t -fill $fill
+}
+
+def Toggle unclick {x y f target} {}
+def Toggle click {x y f target} {
+	if {!$@on} {set @on 1} {set @on 0}
+	netsend [list .$self float $@on]
+	$self changed
+}
+
+class_new Vu {IEMGUI Box}
+
+set vu_col {
+	0 17 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16
+	15 15 15 15 15 15 15 15 15 15 14 14 13 13 13 13 13 13 13 13 13 13 13 19 19 19
+}
+
+def Vu init {mess} {
+	super $mess
+	set @value 0
+	set @peak 0
+}
+
+def Vu bbox {} {
+	mset {x1 y1} [$self xy]
+	list $x1 $y1 [expr $x1+$@w] [expr $y1+$@h]
+}
+
+def Vu led_size {} {
+	set n [expr $@h/40]
+	if {$n < 2} {set n 2}
+	return [expr $n-1]
+}
+
+def Vu draw {} {
+	global vu_col
+	mset {x1 y1 x2 y2} [$self bbox]
+	set colour [parse_color $@bcol]
+	super
+	$self draw_io
+	set led_size [$self led_size]
+	set x3 [expr $x1+$@w/4]
+	set x4 [expr $x2-$@w/4]
+	$self item BASE rectangle [list $x1 $y1 $x2 $y2] -width 0 -fill [color_* [$self look bg] $colour]
+	for {set i 1} {$i<=40} {incr i} {
+		set y [expr $y1 + ($led_size+1)*(41-$i) - ($led_size+1)/2]
+		$self item RMS${i} rectangle [list $x3 $y $x4 [expr $y+$led_size]] \
+		    -fill [parse_color [lindex $vu_col $i]] -width 0
+	}
+	#if {!$@zoom} {return}
+	set lfont [list [lindex {courier helvetica times} $@fstyle] $@fs bold]
+	set lcolor [parse_color $@lcol]
+	set i 0
+	foreach level { <-99 -50 -30 -20 -12 -6 -2 -0dB +2 +6 >+12 } {
+		set k1 [expr $led_size+1]
+		set k2 41
+		set k3 [expr $k1/2]
+		set k4 [expr $y1-$k3]
+		set yyy [expr $k4 + $k1*($k2-4*$i)]
+		$self item SCALE{$level} text [list [expr $x2+4] [expr $yyy+$k3-3]] \
+		    -text $level -anchor w -font $lfont -fill $lcolor
+		incr i
+	}
+	set y [expr $y1 + ($led_size+1)*(41-$@value) - ($led_size+1)/2]
+	$self item MASK rectangle [list $x3 $y1 $x4 $y] -width 0 -fill [color_* [$self look bg] $colour]
+	set c [lindex $vu_col [expr int($@peak)]]
+	set y [expr $y1 + ($led_size+1)*(41-$@peak) - ($led_size+1)/2]
+	$self item PEAK rectangle [list $x1 $y $x2 [expr $y+$led_size]] -fill [parse_color $c] -width 0
+}
+
+def Vu rms=  {rms } {set @value $rms; $self changed rms}
+def Vu peak= {peak} {set @peak $peak; $self changed peak}
+
+def Vu set {i j} {
+	set @value $i
+	set @peak  $j
+	$self changed
+}
+
+catch {
+	package require tkdnd
+	dnd bindtarget . text/uri-list <Drop> {open_file %D}
+}
+
+class_new Dropper {View}
+
+# somewhat broken...
+def Dropper draw {} {
+	set c [$@canvas widget]
+	set isnew [expr [llength [$c gettags ${self}BASE]] == 0]
+	mset {x1 y1} [$self xy]
+	set xs $@w
+	set colour [parse_color $@fcol]
+	set lcolour [parse_color $@lcol]
+	super
+	if {$isnew} {
+		canvas $c.${self}DROP -width $xs -height $xs -bg $colour \
+		    -highlightbackground $lcolour -highlightcolor $colour
+		$c create window [expr $x1+7] [expr $y1-2] -window $c.${self}DROP -anchor nw -tags $c.${self}window
+		if {[catch {
+			dnd bindtarget $c.${self}DROP text/uri-list <Drop> "pd \"x[list ${self}] symbol \[ enquote %D \] ;\""
+		}]} {
+			post "dropper: dnd not installed"
+		}
+	} {
+		$c coords $@canvas.${self}window [expr $x1 + 7] [expr $y1 - 2]
+		$c.${self}DROP configure -width $xs -height $xs -bg $colour \
+		    -highlightbackground $lcolour -highlightcolor $colour
+	}
+}
+
+def Dropper erase {} {destroy $@canvas.${self}DROP; super}
+
+class_new Cnv {Labelled IEMGUI Box}
+
+def Cnv draw {} {
+	mset {x1 y1} [$self xy]
+	$self item BASE rectangle [list $x1 $y1 [expr $x1+$@w] [expr $y1+$@h]] -fill [parse_color $@bcol]
+	super
+}
+
+def Cnv bbox {} {
+	mset {x1 y1} [$self xy]
+	return [list $x1 $y1 [expr $x1+$@w] [expr $y1+$@h]]
+}
+
+class_new Array {Box}
+
+def Array init {mess} {
+	super $mess
+	set @name [lindex $mess 2]
+	set @length 0
+	set @data {}
+	set @draw 0
+}
+
+def Array bbox {} {
+	return {0 0 1 1} ;# huh?
+}
+
+def Array draw_name {} {
+	mset {x_off y_off} [$@canvas xy]
+	$self item TEXT text [lmap + [list $x_off $y_off] 2] \
+		    -font [View_look $self font] -text $@name \
+		    -fill [View_look $self fg] -anchor nw
+}
+
+def Array draw {} {
+	$self draw_name
+	mset {x_off y_off} [$@canvas xy]
+	set m [$@canvas get_mess]
+	mset {xfrom yto xto yfrom pixwidth pixheight} $m
+	if {[winfo exists [$@canvas widget]]} {
+		mset {c_width c_height} [$@canvas get_dimen]
+		set width [expr $c_width / $@length]
+		set i 0
+		foreach val $@data {
+			if {!$val} {set val 0.0}
+			set y [expr $c_height - (((double($val)+abs($yfrom))/($yto-($yfrom)) * $c_height))]
+			set x1 [expr $width * $i]
+			set x2 [expr $x1 + $width]
+			set line [list $x1 $y $x2 $y]
+			$self item elem${i} line $line -fill [$@canvas look compfg] -width 2 -tags "$self ${self}elem${i}"
+			#.$self.c raise ${self}elem${i}
+			incr i
+		}
+	} else {
+		set width [expr $pixwidth / $@length]
+		set canvas [$self get_canvas]
+		set i 0
+		foreach val $@data {
+			if {!$val} {set val 0.0}
+			#set val2 [lindex $@data [expr $i+1]]
+			set y [expr  ($pixheight - ((double($val)+abs($yfrom))/($yto-($yfrom)) * $pixheight)) + $y_off]
+			#set y2 [expr  ($pixheight - ((double($val2)+abs($yfrom))/($yto-($yfrom)) * $pixheight)) + $y_off]
+			set x1 [expr ($width * $i) + $x_off]
+			set x2 [expr $x1 + $width]
+			set line [list $x1 $y $x2 $y]
+			$self item ${self}ELEM${i} line $line -fill [$self look fg] -width 2
+			incr i
+		}
+		[$canvas widget] raise $self
+		#set width [expr $pixwidth / [expr $@length-1]]
+		#set canvas [$self get_canvas]
+		#set i 0
+		#for {set i 0} {$i < [expr $@length-1]} {incr i} {
+		#	#if {!$val} {set val 0.0}
+		#	set val [lindex $@data [expr $i]]
+		#	set val2 [lindex $@data [expr $i+1]]
+		#	set y [expr  ($pixheight - ((double($val)+abs($yfrom))/($yto-($yfrom)) * $pixheight)) + $y_off]
+		#	set y2 [expr  ($pixheight - ((double($val2)+abs($yfrom))/($yto-($yfrom)) * $pixheight)) + $y_off]
+		#	set x1 [expr ($width * $i) + $x_off]
+		#	set x2 [expr $x1 + $width]
+		#	set line [list $x1 $y $x2 $y2]
+		#	$self item ${self}ELEM${i} line $line -fill [$self look fg] -width 0
+		#}
+	}
+}
+
+def Array click {x y f target} {
+	if {[winfo exists [$@canvas widget]]} {set canvas $@canvas} else {set canvas [$@canvas canvas]}
+	$canvas focus= $self
+	set @draw 1
+}
+def Array unclick {x y f target} {
+	if {[winfo exists [$@canvas widget]]} {set canvas $@canvas} else {set canvas [$@canvas canvas]}
+	$canvas focus= ""
+	set @draw 0
+}
+def Array motion {x y f target} {
+	if {!$@draw} return
+	if {[winfo exists [$@canvas widget]]} {
+		mset {c_width c_height} [$@canvas get_dimen]
+		mset {xfrom yto xto yfrom pixwidth pixheight} [$@canvas get_mess]
+		set width [expr $c_width / $@length]
+		set i [format %d [expr int($x/$width)]]
+		set x1 [expr $width * $i]
+		set x2 [expr $x1 + $width]
+		set line [list $x1 $y $x2 $y]
+		set val [expr (($c_height-$y)/$c_height) * ($yto-($yfrom)) + ($yfrom)]
+		netsend [list .$self $i $val]
+	} else {
+		mset {xfrom yto xto yfrom pixwidth pixheight} [$@canvas get_mess]
+		mset {x_off y_off} [$@canvas xy]
+		set width [expr $pixwidth / $@length]
+		set i [format %d [expr int(($x-$x_off)/$width)]]
+		set val [expr (($pixheight-$y+$y_off)/$pixheight) * ($yto-($yfrom)) + ($yfrom)]
+		netsend [list .$self $i $val]
+	}
+}
+def Array length= {val} {set @length [format %f $val]}
+def Array name= {val} {set @name $val}
+def Array array_set {data_list} {
+	if {[llength $data_list] == $@length} {
+		set @data {}
+		for {set i 0} {$i < $@length} {incr i} {
+			lappend @data [lindex $data_list $i]
+		}
+	} else {
+		puts "error....."
+	}
+}
+
+############ evaluator
+
+class_new Listener {Thing}
+
+def Listener init {serf name command} {
+	set @history [History new 20]
+	set @command $command
+	set @expanded 0
+	set @serf $serf
+	frame $serf
+	pack [frame  $serf.1]   -side left -fill y
+	pack [frame  $serf.1.1] -side bottom
+	pack [button $serf.1.1.expander -image icon_plus -command "$self toggle_expand"] -side left
+	pack [label  $serf.1.1.label -width 11 -text "$name: " -font {Courier 10}] -side left
+	pack [entry $serf.entry -width 40 -font $::look(View:font)] -side left -fill x -expand yes
+	pack $serf -fill x -expand no
+	bind $serf.entry <Up>     "$self scroll_history +1"
+	bind $serf.entry <Down>   "$self scroll_history -1"
+	bind $serf.entry <Return> "$self eval"
+}
+
+def Listener toggle_expand {} {
+	set @expanded [expr 1-$@expanded]
+	if {$@expanded} {$self expand} {$self unexpand}
+}
+
+def Listener expand {} {
+	set e $@serf.entry
+	set text [$e get]
+	destroy $e
+	pack [text $e -width 40 -height 8] -side left -fill x -expand yes
+	$e insert 0.0 $text
+	$@serf.1.1.expander configure -image icon_minus
+	bind $e <Alt-Return> "$self eval"
+}
+
+def Listener unexpand {} {
+	set e $@serf.entry
+	set text [$e get 0.0 end]
+	regsub "\n$" $text "" text
+	destroy $e
+	pack [entry $e -width 40] -side left -fill x -expand yes
+	$e insert 0 $text
+	$@serf.1.1.expander configure -image icon_plus
+	bind $e <Up>     "$self up"
+	bind $e <Down>   "$self down"
+	bind $e <Return> "$self eval"
+}
+
+def Listener replace {stuff} {
+	$@serf.entry delete 0 end
+	$@serf.entry insert 0 $stuff
+	$@serf.entry icursor end
+}
+
+def Listener scroll_history {incr} {
+	if {![$@history histi]} {$@history set_hist 0 [$self get_command]}
+	$self replace [$@history traverse $incr]
+	
+}
+
+def Listener append {v}  {
+	$@history prepend $v
+	lappend @hist $v; set @histi [llength $@hist]
+}
+
+def Listener get_command {} {
+	set e $@serf.entry
+	if {$@expanded} {
+		set l [$e get 0.0 end]; return $l
+	} else {
+		set l [$e get]; return $l
+	}
+
+}
+
+def Listener eval {} {
+	set e $@serf.entry
+	$@history histi= 0
+	set l [$self get_command]
+	$self append $l
+	if {$@expanded} {$e delete 0.0 end} {$e delete 0 end}
+	$@command $self $l
+}
+
+proc tcl_eval {self l} {post %s "tcl: $l"; post %s "returns: [uplevel [info level] $l]"}
+proc  pd_eval {self l} {post %s "pd: $l"; netsend $l}
+proc canvas_eval {self l} {post %s "tcl: $l"; post %s "returns: [uplevel [info level] [join [list [$self canvas] $l]]]"}
+############ button bar
+
+set butt {
+	{ObjectBox  Object  {obj}}
+	{MessageBox Message {msg}}
+	{FloatBox   Number  {floatatom}}
+	{SymbolBox  Symbol  {symbolatom}}
+	{CommentBox Comment {text}}
+	{bng     bng    {obj bng}}
+	{tgl     tgl    {obj tgl}}
+	{nbx     nbx    {obj nbx}}
+	{vsl     vsl    {obj vsl}}
+	{hsl     hsl    {obj hsl}}
+	{vradio  vradio {obj vradio}}
+	{hradio  hradio {obj hradio}}
+	{vu      vu     {obj vu}}
+	{cnv     cnv    {obj cnv}}
+	{Graph   graph  {graph}}
+	{Array   array  {menuarray 0}}
+}
+#	{dropper dropper    {pd %W dropper 0}}
+
+proc button_bar_add {x y} {
+	global butt
+	lappend butt [list $x $y noload]
+}
+
+if {$tk} {
+	set dir $cmdline(icons)
+	foreach icon {mode_edit mode_run pd}     {image create photo icon_$icon -file $dir/$icon.gif}
+	foreach b $butt {mset {icon name cmd} $b; image create photo icon_$icon -file $dir/$icon.gif}
+}
+
+class_new ButtonBar {View}
+
+def ButtonBar init {canvas} {
+	set @canvas $canvas
+	set bb .$@canvas.bbar
+	frame $bb
+	pack [button $bb.edit -image icon_mode_edit -border 1 -command [list $@canvas editmodeswitch]] -side left
+	foreach e $::butt {
+		mset {icon name cmd} $e
+		pack [button $bb._$name -image icon_$icon -border 1 -command "$@canvas new_object $cmd"] -side left
+		balloon $bb._$name [say $name]
+	}
+	pack [entry $bb.name -font {helvetica -12} -width 8 -border 0] -side right
+	pack [spinbox $bb.scale -width 5 -command "$canvas zooming %d" -state readonly] -side right
+	$bb.scale set [format %d%% [expr int(100*[$@canvas zoom])]]
+	$bb.name insert 0 $@canvas
+}
+
+def ButtonBar widget {} {return .$@canvas.bbar}
+
+proc obj_create {c flag} {}
+
+############ crosshair
+
+class_new Crosshair {View}
+
+def Crosshair classtags {} {return {}}
+
+def Crosshair init {canvas} {
+	super
+	set @canvas $canvas
+	$self data= 0 0 {none}
+}
+
+def Crosshair data= {x y target} {
+	set @x $x
+	set @y $y
+	set @target $target
+}
+
+def Crosshair draw {} {
+	
+	mset {type id detail} $@target
+	set x $@x; set y $@y
+	
+	if {[$@canvas look hairsnap]} {
+		switch -regexp -- $type {^object|outlet|inlet$ {mset {x y x3 y3} [$id bbox]}}
+	}
+	mset {x1 y1 x2 y2} [$self display_area]
+
+	set h1 [list $x1 $y $x2 $y]
+	set v1 [list $x $y1 $x $y2]
+	$self item VHAIR1 line $v1 -fill [$@canvas look crosshair] -width 1 -dash {4 4 4 4}
+	$self item HHAIR1 line $h1 -fill [$@canvas look crosshair] -width 1 -dash {4 4 4 4}
+}
+
+#def Crosshair erase {} {$self item_delete VHAIR1; $self item_delete HHAIR1}
+class_new Sense {View}
+
+def Sense init {canvas} {
+	super
+	set @canvas $canvas
+	$self data= 0 0 0 red
+}
+
+def Sense data= {x y range col} {
+	set @x $x
+	set @y $y
+	set @range $range
+	set @col $col
+}
+
+def Sense flash {x y sense col} {
+	$self data= $x $y $sense $col
+	$self draw
+	after 500 $self erase
+}
+
+def Sense draw {} {
+	set c [$@canvas widget]
+	set x1 [expr $@x-$@range]; set y1 [expr $@y-$@range]
+	set x2 [expr $@x+$@range]; set y2 [expr $@y+$@range]
+	$self item SENSE oval [list $x1 $y1 $x2 $y2] -fill $@col -outline yellow
+}
+
+def View display_area {} {
+	set c [$@canvas widget]; set z [$@canvas zoom]
+	set edge 10
+	set x1 [expr {int([$c canvasx $edge]/$z)}]
+	set y1 [expr {int([$c canvasy $edge]/$z)}]
+	set x2 [expr {int(([$c canvasx [winfo width $c]]-$edge)/$z)}]
+	set y2 [expr {int(([$c canvasy [winfo height $c]]-$edge)/$z)}]
+	return [list $x1 $y1 $x2 $y2]
+}
+
+class_new Grid {View}
+
+def Grid init {canvas} {
+	super
+	set @canvas $canvas
+	set c [$@canvas widget]
+	set @width [winfo width $c]
+	set @height [winfo height $c]
+	set @size [$@canvas look grid_size]
+	set @col [$@canvas look grid]
+	set @gap 5
+}
+
+def Grid classtags {} {return {}}
+
+def Grid update {h w} {set @width $w; set @height $h}
+def Grid size= {size} {set @size $size}
+def Canvas snap_grid {} {return [$self look snap_grid]}
+def Canvas snap_grid= {val} {set ::look(Canvas:snap_grid) $val}
+
+def Canvas snap_objs2grid {} {
+	if {![$self editmode]} {return}
+	foreach obj [$@objects values] {
+		mset {x y} [$obj xy]
+		set grid [$self look grid_size]
+		set x [expr floor($x/$grid)*$grid]
+		set y [expr floor($y/$grid)*$grid]
+		$obj moveto $x $y
+	}
+}
+
+def Grid draw {} {
+	mset {x1 y1 x2 y2} [$self display_area]
+	set c [$@canvas widget]
+	set lowest [$@canvas lowest_item]
+	$self draw_lines $x1 $x2 $y1 $y2 VL
+	$self draw_lines $y1 $y2 $x1 $x2 HL
+	if {$lowest != -1} {$c lower $self $lowest}
+}
+
+def Grid draw_lines {v1 v2 v3 v4 tag} {
+	set s $@size; set g $@gap
+	for {set i $v1} {$i < $v2} {incr i} {
+		#if {$l%$g == 0} {set width 1;set dash [list 7 1]} {set width 1;set dash [list 1 4 1 4]}
+		if {![expr {$i % int($s*$g)}]} {set w 1;set d [list 7 1]} {set w 1;set d [list 1 4 1 4]}
+		if {![expr {$i % int($s)}]} {
+			switch $tag {VL {set line [list $i $v3 $i $v4]} HL {set line [list $v3 $i $v4 $i]}}
+			$self item ${tag}$i line $line -fill $@col -width $w -dash $d
+		}
+	}
+}
+
+def Canvas lowest_item {} {
+	set c [$self widget]
+	set all [$c find withtag foo]
+	if {![llength $all]} {return -1}
+	set lowest [lindex [$c gettags [lindex $all 0]] 0]
+	return $lowest
+}
+
+#def Canvas grid_size {} {return [$self look grid_size]}
+def Canvas grid_size= {size} {
+	set ::look(Canvas:grid_size) $size
+	if {[$self editmode]} {$@grid size= $size; $@grid erase; after 0 $@grid draw}
+}
+############ tooltips (only those that are drawn as canvas items)
+
+class_new Tooltip {View}
+
+def Tooltip init {canvas pos curpos text type iserror} {
+	set @canvas $canvas
+	set @pos $pos
+	set @curpos $curpos
+	set @text $text
+	set @type $type
+	set @iserror $iserror
+}
+
+def Tooltip iserror {} {return $@iserror}
+def Tooltip curpos  {} {return $@curpos}
+def Tooltip text    {} {return $@text}
+
+def Tooltip draw {} {
+	set c [$@canvas widget]
+	if {$@iserror} {
+		set fg "#ffffff"; set bg "#dd0000"
+	} else {
+		set fg "#000000"; set bg "#ffffcc"
+	}
+	mset {x y} $@pos
+	switch -- $@type {
+		o {set ny [expr {$y+24}]}
+		i {set ny [expr {$y-24}]}
+	}
+	$self item TEXT text [list [expr $x+12] $ny] -fill $fg -text $@text -anchor w
+	mset {x1 y1 x2 y2} [l+ [$c bbox ${self}TEXT] [list -4 -4 +4 +4]]
+	switch -- $@type {
+	  o {set coords [list $x1 $y1 [expr $x1+8] $y1 $x $y [expr $x1+16] $y1 $x2 $y1 $x2 $y2 $x1 $y2 $x1 $y1]}
+	  i {set coords [list $x1 $y1 $x2 $y1 $x2 $y2 [expr $x1+16] $y2 $x $y [expr $x1+8] $y2 $x1 $y2 $x1 $y1]}
+	}
+	$self item RECT polygon $coords -fill $bg -outline $fg
+	$c lower ${self}RECT ${self}TEXT
+}
+
+# $c delete tooltip_bg tooltip_fg
+
+set tooltip ""
+
+def Canvas show_tooltip {x y text type {iserror 0}} {
+	global tooltip
+	if {$tooltip ne "" && [$tooltip text] eq $text} {return}
+	if {$tooltip ne ""} {$tooltip delete}
+	set tooltip [Tooltip new $self [list $x $y] $@curpos $text $type $iserror]
+	$tooltip draw
+}
+
+############ class browser
+
+class_new ServerClassDict {Observable Thing}
+def ServerClassDict init {} {
+
+}
+
+# Completion/Browser init can be cleaned up a bit more, do it later...
+class_new ClassBrowser {Dialog}
+class_new Browser {ClassBrowser}
+def Browser init {name x y textbox} {super $name $x $y $textbox}
+class_new Completion {ClassBrowser}
+def Completion init {name x y textbox} {super $name $x $y $textbox}
+
+def Completion cancel {} {
+	bind $@textbox <Key>            "$@textself key_input %W %x %y %K %A 0"
+	bind $@textbox <Control-Return> "$@textself key_input %W %x %y 10 %A 0"
+	bind $@textbox <Return>         "$@textself unedit"
+	bind $@textbox <Tab>            "$@textself key_input %W %x %y %K %A 0"
+	focus $@textbox
+	$self delete
+}
+def ClassBrowser delete {} {set @exist 0; super}
+
+def ClassBrowser init {name x y textbox} {
+	set @name $name
+	set @width 0
+	set @height 0
+	# so that in completion mode, it know which textbox to switch the focus to
+	set @textbox $textbox
+	netsend [list pd update-path]
+        netsend [list pd update-class-list $self list_callback]
+}
+
+def ClassBrowser fill_box {s} {
+	global class_list
+	$@listbox delete 0 end
+	foreach class $class_list {
+		if {[string length $s]==0 || [string first $s $class]>=0} {
+			set t "\[$class\]"
+			if {[can_say $class]} {append t "  [say $class]"}
+			$@listbox insert end $t
+			#if {[string length $t] > [string length $@width]} {set @width [string length $t]}
+			if {[string length $t] > $@width} {set @width [string length $t]}
+		}
+	}
+	set none [say no_matches]
+	if {![$@listbox size]} {$@listbox insert 0 $none; set @width [string length $none]}
+	$@listbox selection set 0 0
+}
+ 
+def Completion fill_box {s} {
+	super $s
+	wm maxsize .$self [winfo reqwidth .$self.comp] [winfo reqheight .$self.comp]
+}
+
+def Browser fill_box {s} {
+	super $s
+	.$self.title configure -text [format [say how_many_object_classes] [$@listbox size] [llength $::class_list]]
+}
+
+def ClassBrowser search_for_externs {} {
+	global pd_path class_list
+	foreach dir $pd_path {
+		catch {
+			set xs [glob "$dir/*.pd*"]
+			foreach x $xs {
+				set fn [lindex [file split $x] end]
+				set fn [join [lrange [split $fn .] 0 end-1] .]
+				lappend class_list $fn
+			}
+		}
+	}
+}
+
+def ClassBrowser info {listbox} {
+	set class [$self current_class]
+	if {$class != ""} {netsend [list pd update-class-info $class $self info_callback]}
+}
+
+def Browser list_callback {} {
+	$self search_for_externs
+	set class_list [luniq [lsort $::class_list]]
+
+	toplevel .$self
+	set f .$self.cl
+	pack [frame $f] -side top -fill both -expand yes
+	pack [label .$self.title -text ""] -side top
+	listbox $f.1 -width 50 -height 20 -yscrollcommand "$f.2 set" -activestyle none
+	scrollbar $f.2 -command "$f.1 yview"
+	text    $f.3 -width 30 -height 20 -yscrollcommand "$f.4 set"
+	scrollbar $f.4 -command "$f.3 yview"
+	set @listbox $f.1
+
+	frame $f.5
+	button $f.5.help -text [say help] -command [list $self help]
+	pack $f.5.help -side top
+	pack $f.5 -side left -fill    y -expand no
+	pack $f.1 -side left -fill both -expand yes
+	pack $f.2 -side left -fill    y -expand no
+	pack $f.3 -side left -fill both -expand yes
+	pack $f.4 -side left -fill    y -expand no
+
+	set b .$self.butt
+	frame $b
+	pack [label $b.1 -text [say filter]] -side left
+	pack [entry $b.2 -width 15] -side left
+	pack [button $b.close -text [say close] -command "destroy .$self"] -side right
+	pack $b -side bottom -fill x -expand no
+	set @textbox $b.2
+	$self fill_box ""
+	#bind $f.1 <Button-1> "after 1 \"$self info $f.1 \""
+	foreach w [list $f.1 $b.2] {
+		bind $w       <KeyPress> "after 1 \"$self key %K 0\""
+		bind $w <Shift-KeyPress> "after 1 \"$self key %K 1\""
+		bind $w <Return> [list $self help]
+	}
+	focus $@textbox
+}
+
+def Browser help {} {
+	set f .$self.cl
+	netsend [list pd help [$self current_class]]
+}
+
+def Completion list_callback {} {
+	$self search_for_externs
+	set class_list [luniq [lsort $::class_list]]
+	toplevel .$self
+	wm protocol .$self WM_DELETE_WINDOW "$self cancel"
+	wm overrideredirect .$self 1
+	set canvas $@name
+	set f .$self.comp
+	set @listbox $f
+	set @rootx [winfo rootx .$@name.c]
+	set @rooty [winfo rooty .$@name.c]
+	set @max [wm maxsize .$self]
+	if {[regexp {(x[0-9a-z]{6,8})text$} $@textbox dummy textself]} {set @textself $textself}
+	if {[$canvas look showcomp] <= 20} {set @height [$canvas look showcomp]} else {set @height 20}
+	listbox $f -width $@width -height $@height -relief flat -activestyle dotbox -font $::look(View:font) \
+	    -bg [$@textself look bg] -selectbackground [$@textself look fg] \
+	    -fg [$@textself look fg] -selectforeground [$@textself look bg]
+	$self adjust_box
+	bind $f <Button-1> "after 1 \"$self complete\""
+	bind $f <Return>   "after 1 \"$self complete\""
+	bind $f       <KeyPress> "$self key %K 0"
+	bind $f <Shift-KeyPress> "$self key %K 1"
+	bind $@textbox <Tab>      "$self key %K; break"
+	bind $@textbox <KeyPress> "$self key %K "
+	focus .$self.comp
+}
+
+def Completion adjust_box {} {
+	mset {x1 y1 x2 y2} [lmap * [$@textself bbox] [$@name zoom]]
+	set x1 [format %0.f $x1];set y1 [format %0.f $y1]
+	set x2 [format %0.f $x2];set y2 [format %0.f $y2]
+	$self fill_box [$@textbox get 1.0 1.end]
+	set f .$self.comp
+	$f configure -width $@width
+	set box_width  [winfo reqwidth  $f]
+	set box_height [winfo reqheight $f]
+	pack $f -side left -expand yes
+
+	.$self configure -width $box_width
+	.$self configure -height $box_height
+
+	#test the right edge of the screen, assuming the left edge has enough space
+	if {[expr $x1+$@rootx+$box_width] < [lindex $@max 0]} {
+		set box_x [expr $x1+$@rootx]
+	} else {
+		set box_x [expr $x2 - $box_width + $@rootx]
+	}
+	#test the lower edge of the screen, assuming the upper edge has enough space
+	if {[expr $y2+$@rooty+$box_height] < [lindex $@max 1]} {
+		set box_y [expr $y2 + 5 + $@rooty]
+	} else {
+		set box_y [expr $y1 - $box_height - 2 + $@rooty]
+	}
+
+	wm geometry .$self [winfo reqwidth .$self]x[winfo reqheight .$self]+$box_x+$box_y
+
+}
+
+def ClassBrowser current_class {} {
+	set i [$@listbox curselection]
+	if {$i == ""} {return {}}
+	return [string range [lindex [$@listbox get $i] 0] 1 end-1]
+}
+
+def ClassBrowser complete {} {
+	if {[regexp {x([0-9a-z]{6,8})text$} $@textbox obj]} {
+		set cut [string first "text" $obj]
+		set obj [string range $obj 0 [expr $cut -1]]
+	}
+	set class [$self current_class]
+	$@textbox delete 1.0 1.end
+	$@textbox insert 1.0 $class
+
+	$obj unedit
+	destroy .$self
+}
+
+def ClassBrowser key {key {shift 0}} {
+ 	switch -regexp -- $key {
+		Up|Down {
+			if {[focus] != $@listbox} {
+				focus $@listbox
+				event generate $@listbox <KeyPress> -keysym $key
+			} else {
+				if {$self == "browser"} {$self info $@listbox}
+			}
+		}
+		Escape {after 1 "$self cancel"} ;# doesn't really work
+		Tab {
+			focus $@listbox
+			set next [$@listbox index active]
+			incr next
+			if {$next >= [$@listbox size]} {set next 0}
+			$@listbox activate $next
+			$@listbox selection clear 0 [expr [$@listbox size] - 1]
+			$@listbox selection set $next $next
+			#if {$next >= [expr $@height - 1]} {$@listbox yview scroll 1 units}
+			$@listbox see $next
+			if {$self == "browser"} {$self info $@listbox}
+		}
+		BackSpace {
+			if {[focus] == $@listbox} {focus $@textbox}
+			#classbrowser uses entry as input widget, where as completion is text widget...
+			switch $self {
+				browser {$self fill_box [$@textbox get]}
+				completion {$self adjust_box; $@textself resize; $@textself changed}
+			}
+		}
+		default {
+			$self key_default $key
+		}
+	}
+}
+
+def Browser key_default {key} {
+	if {[focus] == $@listbox} {
+		if {[regexp {^[a-zA-Z0-9~/\._]{1}$} $key]} {
+			.$self.butt.2 insert end $key
+			$self fill_box [$@textbox get]
+		}
+	} else {$self fill_box [$@textbox get]}
+}
+
+def Completion key_default {key} {
+	if {[focus] == $@listbox} {
+		if {[regexp {^[a-zA-Z0-9~/\._]{1}$} $key]} {
+			$@textbox insert 1.end $key
+			$@textself after_key $@textbox
+			$self adjust_box
+			focus $@textbox
+		}
+	}
+	if {[focus] == $@textbox & $key != "Tab"} {
+		$self adjust_box
+		$@textself resize
+		#hum, no idea why i need after 1 for it to work...
+		after 1 $@textself after_key $@textbox
+	}
+}
+
+def ClassBrowser info_callback {class} {
+	global class_info
+	set f .browser.cl
+	set class [$self current_class]
+	$f.3 delete 0.0 end
+	$f.3 insert end "class $class\n"
+	foreach {k v} $class_info($class) {$f.3 insert end "$k=\"$v\"\n"}
+}
+
+def TextBox propose_completions {} {
+	set c [$@canvas widget]
+	set widget $c.${self}text
+	set propose $c.${self}propose
+	#$propose configure -state normal
+	if {![info exists ::class_list]} {
+		netsend [list pd update-class-list $self propose_completions]
+		return
+	}
+	set r {}
+	set c {}
+	set n 0
+	set prev ""
+	foreach class [luniq [lsort $::class_list]] {
+		if {[string length $@text]==0 || [string first $@text $class]>=0} {
+			if {[string compare [say $class] "{{$class}}"]} {
+				lappend r "$class : [say $class]"
+			} {
+				lappend r $class
+			}
+			lappend c $class
+			incr n
+		}
+		if {$n > 16} {lappend r ...; break}
+	}
+	set r [join $r "\n"]
+	mset {x1 y1 x2 y2} [$self bbox]
+	set @action [Completion new_as completion $@canvas $x1 $y1 $widget]
+}
+
+############ properties_dialog #########
+proc change_entry {self val} {
+	set v [expr [$self get]+$val]
+	$self delete 0 end
+	$self insert 0 $v
+}
+
+class_new Dialog {View}
+
+def Dialog add_stuff {f name label} {
+	frame $f
+#	frame $f.label -width $@label_width -borderwidth 2
+#	pack  [button  $f.label.0 -image "icon_empty" -width $@label_width] -side left
+#	place [message $f.label.1 -text $label        -width $@label_width] -x 0 -y 0
+#	puts [$f.label.1 cget -height]
+	pack [label $f.label -text $label -width [expr $@label_width/7] -wraplength $@label_width -anchor e] -side left
+	balloon $f.label $name
+}
+
+def Dialog add_side {f name label} {
+	$self add_stuff $f $name $label
+	frame $f.side -relief ridge -borderwidth 2
+	foreach {i side} {0 left 1 right 2 top 3 bottom} {
+		radiobutton $f.side.$side -value $i -variable @$name -text $side
+	}
+	pack $f.side.left   -side   left -fill y
+	pack $f.side.right  -side  right -fill y
+	pack $f.side.top    -side    top
+	pack $f.side.bottom -side bottom
+	pack $f.side -side left
+}
+
+def Dialog add_color {f name label} {
+	$self add_stuff $f $name $label
+	set v $@$name
+	set text_color [complement $v]
+	button $f.color -text $v -font {Courier 10} -width 10 -pady 2 -fg $text_color \
+	    -command [list $self choose_col $f $name $v] -relief sunken -background $v \
+	    -highlightbackground "#ffffff" -activebackground [darker $v]
+	button $f.preset -text [say "preset"] -pady 2 -font {Helvetica 8} \
+	    -command [list $self color_popup $f $name 10]
+	bind $f.preset <Return> "$self color_popup $f $name 10"
+	pack $f.color $f.preset -side left
+}
+
+
+def Dialog add_choice {f name label choices} {
+	$self add_stuff $f $name $label
+	menu $f.menu -tearoff 0
+	set i 0
+	foreach part $choices {
+		$f.menu add command -label [say $part] -command [list $self dropmenu_set $f $name $part $i]
+		incr i
+	}
+	set trim_name [string trimleft $name "-"]
+	set _($self:${name}choices) $choices
+	set choice $@$name
+	if {[string is integer $choice]} {set choice [lindex $choices $choice]}
+	label $f.butt -text [say $choice] -relief raised -width 20
+	balloon $f.butt "click to change setting"
+	pack $f.label $f.butt -side left
+	bind $f.butt <1> [list $self dropmenu_open $f $name]
+}
+
+def Dialog add_key {f name label} {
+	set text ""
+	set n 0
+	foreach item $name {
+		if {$n != 0} {append text " & " [say $item]} else {set text [say $item]}
+		incr n
+	}
+	$self add_stuff $f $name $text
+	#balloon $f.label $name
+	foreach item $name {
+		set v $_($self:$item) ;# bug in objtcl
+		set item_lower [string tolower $item]
+		entry $f.$item_lower -width 15 -textvariable @$item
+		pack $f.$item_lower -side left
+	}
+}
+
+def Dialog add_folders {f name label} {
+	$self add_stuff $f $name $label
+	set v $_($self:$name) ;# bug in poetcl
+	frame $f.a
+	listbox $f.a.list -width 40 -height 8 -yscrollcommand "$f.a.yscroll set" \
+	    -activestyle none -xscrollcommand "$f.a.xscroll set"
+	foreach line $v {$f.a.list insert end $line}
+	set @$name $f.a.list ;# save the listbox path at @$name instead
+	scrollbar $f.a.yscroll -command "$f.a.list yview"
+	scrollbar $f.a.xscroll -command "$f.a.list xview" -orient horizontal
+	pack $f.a.xscroll -side bottom -fill x
+	pack $f.a.list -side left -fill both -expand 1
+	pack $f.a.yscroll -side left -fill y
+	pack $f.a -side left
+	frame $f.b -borderwidth 0
+	foreach {cmd lab} {dir_add add listbox_remove remove listbox_up up listbox_down down} {
+		pack [button $f.b.$cmd -command "$self $cmd $f.a.list" -text [say $lab] -width 6] -side top
+		balloon $f.b.$cmd [say dir_$lab]
+	}
+	pack $f.b -side top
+}
+
+def Dialog add_libraries {f name label} {
+	$self add_stuff $f $name $label
+	set v $_($self:$name) ;# bug in objtcl
+	frame $f.a
+	listbox $f.a.list -width 32 -height 16 -yscrollcommand "$f.a.yscroll set" \
+	    -activestyle none -xscrollcommand "$f.a.xscroll set"
+	#foreach line $@$name {$f.a.list insert end $line}
+	foreach line $v {$f.a.list insert end $line}
+	# save the listbox path at @$name instead
+	set @$name $f.a.list
+	scrollbar $f.a.yscroll -command "$f.a.list yview"
+	scrollbar $f.a.xscroll -command "$f.a.list xview" -orient horizontal
+
+	pack $f.a.xscroll -side bottom -fill x
+	pack $f.a.list -side left -fill both -expand 1
+	pack $f.a.yscroll -side left -fill y
+	pack $f.a -side left
+
+	frame $f.b       -borderwidth 0
+	entry $f.b.entry -width 15 -borderwidth 5 -relief ridge
+	bind  $f.b.entry <Return> "$self lib_add $f.a.list"
+	pack  $f.b.entry -side top
+
+	foreach {cmd lab} {lib_add add listbox_remove remove listbox_up up listbox_down down} {
+		pack [button $f.b.$cmd -command "$self $cmd $f.a.list" -text [say $lab] -width 6] -side top
+		balloon $f.b.$cmd [say dir_$lab]
+	}
+	pack $f.b -side top
+}
+
+def Dialog dir_add {listbox} {
+	set dir [tk_chooseDirectory -initialdir ~ -title "Choose a folder" -parent .$self]
+	if {$dir == ""} {return}
+	$listbox insert end $dir
+	$listbox yview end
+	focus .$self
+}
+
+# doesn't work with toplevel widget
+proc upwidget {levels name} {
+	set l [split $name .]
+	return [join [lrange $l 0 end-$levels] .]
+}
+
+def Dialog lib_add {f} {
+	set f [upwidget 2 $f]
+	set listbox $f.a.list
+	set entry $f.b.entry
+	set var [$entry get]
+	if {$var != ""} {$listbox insert end $var}
+	$listbox yview end
+	$entry delete 0 end
+	focus $entry
+}
+
+def Dialog listbox_remove {listbox} {
+	set sel [$listbox curselection]
+	if {$sel == ""} {return}
+	$listbox delete $sel
+	$listbox selection set $sel
+}
+
+def Dialog listbox_swap {listbox dir} {
+	set sel [$listbox curselection]
+	if {$sel == ""} {return}
+	if {![inside [expr $sel+$dir] 0 [$listbox size]]} {return}
+	set line [$listbox get $sel]
+	$listbox delete $sel
+	incr sel $dir
+	$listbox insert $sel $line
+	$listbox selection set $sel
+	$listbox see $sel
+}
+
+def Dialog add_devlist {f name label} {
+	$self add_stuff $f $name $label
+	menu $f.menu -tearoff 0
+	set i 0
+	set trim_name [string trimleft $name "-"]
+	set part none ;# in case there are none
+	foreach part $@$trim_name {
+		$f.menu add command -label $part -command [list $self dropmenu_set $f $name $part $i]
+		incr i
+	}
+	#label $f.butt -text [lindex $@$trim_name 0] -relief raised -width 20
+	label $f.butt -textvariable _($self:${trim_name}0) -relief raised -width 20
+	balloon $f.butt "click to change setting"
+	pack $f.label $f.butt -side left
+	bind $f.butt <1> [list $self dropmenu_open $f $name]
+}
+
+def Dialog add_spins {f name label option} {
+	global _
+	$self add_stuff $f $name $label
+	set i 0
+	set trim_name [string trimleft $name "-"]
+	set n [llength $@$option]
+	foreach part $@$trim_name {
+		if {$i < $n} {set s "readonly"} else {set s "disabled"}
+		set v "_($self:$trim_name${i})"
+		spinbox $f.$i -width 2 -command "$self spinning %d $v" -state $s -textvariable $v
+		pack $f.$i -side left
+		balloon $f.$i "Device [expr $i+1]"
+		incr i
+	}
+}
+
+def Dialog spinning {mode v} {
+	switch $mode {
+		up {incr $v; puts " incr $v"}
+		down {incr $v -1}
+	}
+}
+
+def Dialog listbox_up   {listbox} {$self listbox_swap $listbox -1}
+def Dialog listbox_down {listbox} {$self listbox_swap $listbox +1}
+
+def Dialog add {w args} {
+	foreach row $args {
+		set name [lindex $row 0]
+		set type [lindex $row 1]
+		set options [lrange $row 2 end]
+		set f $w.$name
+		set label "[say $name]: "
+		set k [lsearch $options -choices]
+		if {$k>=0} {
+			set choices [lindex   $options    [expr $k+1]]
+			set options [lreplace $options $k [expr $k+1]]
+		}
+		#set v $@$name
+		#set v $_($self:$name) ;# bug in poetcl
+		switch -- $type {
+			side      {$self add_side      $f $name $label}
+			color     {$self add_color     $f $name $label}
+			font      {$self add_font      $f $name $label $options}
+			choice    {$self add_choice    $f $name $label $choices}
+			key       {set f $w.[string tolower [lindex $name 0]]
+				   $self add_key       $f $name $label}
+			folders   {$self add_folders   $f $name $label}
+			libraries {$self add_libraries $f $name $label}
+			devlist   {$self add_devlist $f $name $label}
+			spins     {$self add_spins $f $name $label $options}
+			section    {label $f -text $label -bg "#0000aa" -fg "#ffff55" -font {helvetica -10 bold}}
+			subsection {label $f -text $label -bg "#0000aa" -fg "#ffff55" -font {helvetica -10 bold}}
+			toggle {
+				$self add_stuff $f $name $label
+				eval [concat [list checkbutton $f.toggle -variable @$name] $options]
+				pack $f.toggle -side left
+			}
+			default {
+				$self add_stuff $f $name $label
+				set trim_name [string trimleft $name "-"]
+				eval [concat [list entry $f.entry -textvariable _($self:$trim_name)] $options]
+				pack $f.entry -side left
+				bind $f.entry <Return> "$self ok"
+				switch -regexp -- $type {
+					integer|float|fontsize {
+						frame $f.b -borderwidth 0
+						button $f.b.1 -image icon_wedge_up   -command "change_entry $f.entry +1"
+						button $f.b.2 -image icon_wedge_down -command "change_entry $f.entry -1"
+						pack $f.b.1 $f.b.2 -side top
+						pack $f.b -side left
+						bind $f.entry <Button-4> "change_entry $f.entry +1"
+						bind $f.entry <Button-5> "change_entry $f.entry -1"
+					}
+					entry {}
+					default {
+						label $f.type -text "($type)" -fg "#808080"
+						pack $f.type -side right -anchor e
+					}
+				}
+			}
+		}
+		pack $f -side top -fill x
+	}
+}
+
+proc logvar {args} {
+	set r {}
+	foreach var $args {
+		regsub {^_\(.*:(.*)\)$} $var {@\1} var2
+		lappend r "$var2=[uplevel 1 list \$$var]"
+	}
+	puts [join $r "; "]
+}
+
+def Dialog spinbox_update {mode} {puts " $mode"}
+
+def Dialog add_font {f name label class} {
+	$self add_stuff $f $name $label
+	set v $@$name
+	label $f.font -text $v -font [lreplace $v 1 1 -10] -width [string length $v] -height 1 -pady 3 -fg black \
+	    -relief sunken -bg white
+	button $f.preset -text [say "edit"] -pady 2 -font {Helvetica 8} \
+	    -command "FontDialog new_as $name $class $f.font"
+	pack $f.font $f.preset -side left
+}
+
+class_new FontDialog {Dialog}
+
+def Canvas fd {} {FontDialog new_as view_font [$self look font] "View"}
+
+def FontDialog init {class orig} {
+	if {[winfo exists .$self]} {return}
+	super cancel ok
+	set f .$self
+	set @class $class
+	set @orig $orig
+	bind all <KeyPress-F1> help
+	set font $::look($@class:font)
+	set @family [lindex $font 0]
+	set @size   [expr -[lindex $font 1]]
+	set @bold   [expr [lsearch $font bold  ]>=0]
+	set @italic [expr [lsearch $font italic]>=0]
+	set @str $font
+	logvar @family @size @bold @italic
+	pack [label $f.label -text [say font_family] -anchor w] -side top -fill x
+	frame $f.list -bd 2
+	
+	pack [listbox $f.list.box -relief sunken -yscrollcommand "$f.list.scroll set"] -side left
+	pack [scrollbar $f.list.scroll -relief sunken -command "$f.list.box yview" -takefocus 0] -side right -fill y
+	bind $f.list.box <<ListboxSelect>> "$self font_update $f"
+	foreach name [lsort [font families]] {$f.list.box insert end $name}
+
+	set fontlist [$f.list.box get 0 end]
+	set find [lsearch $fontlist $@family]
+	if {$find < 0} {set find 0}
+	$f.list.box selection set $find $find
+	$f.list.box activate $find
+	$f.list.box see $find
+	bind $f.list.box <ButtonRelease-1> "$self font_update $f"
+	bind $f.list.box <ButtonPress-1> "focus $f.list.box"
+
+	frame $f.var
+	frame $f.var.size
+	pack [label $f.var.size.label -text [say font_size]] -side left
+	pack [spinbox $f.var.size.entry -relief sunken -textvariable fontsize -width 4 \
+		      -command "$self font_changesize $f %d"] -side left
+	bind $f.var.size.entry <KeyPress-Return> "$self font_update_size $f"
+	$f.var.size.entry delete 0 end
+	$f.var.size.entry insert 0 $@size
+
+	frame $f.var.style
+	pack [label $f.var.style.label -text [say font_style]] -side left
+	set cmd [list $self font_update $f]
+	pack [checkbutton $f.var.style.bold   -text [say font_bold]   -variable @bold   -command $cmd] -side top
+	pack [checkbutton $f.var.style.italic -text [say font_italic] -variable @italic -command $cmd] -side top
+
+	pack $f.var.size -side left 
+	pack $f.var.style -side left -padx 20
+
+	frame $f.preview
+	pack [label  $f.preview.label -text [say font_preview]] -side left
+	pack [canvas $f.preview.canvas -width 250 -height 50 -relief sunken -borderwidth 1]  -side left -fill x
+	$f.preview.canvas create text 4 4 -tags ${self}TEXT -anchor nw -text [say font_preview_2] -font $font
+
+	pack $f.list  -side left
+	pack $f.var -side top -fill x
+	pack $f.preview -side top -pady 10
+	focus $f.list.box
+	$self none_resizable
+}
+
+def FontDialog font_update {f} {
+	global font
+	set lb $f.list.box
+	set @family [$lb get [$lb curselection]]
+	set @str [list $@family [expr -$@size]]
+	if {$@bold  } {lappend @str bold  }
+	if {$@italic} {lappend @str italic}
+	# logvar @str
+	$f.preview.canvas itemconfigure ${self}TEXT -font $@str
+}
+
+def FontDialog font_changesize {f mode} {
+	switch $mode {
+		up   {set @size [expr $@size+1]}
+		down {set @size [expr $@size-1]}
+	}
+	$f.var.size.entry delete 0 end
+	$f.var.size.entry insert 0 $@size
+	$self font_update $f
+}
+
+def FontDialog font_style {f bold} {
+	set @bold $bold
+	$self font_update $f
+}
+
+def FontDialog font_update_size {f} {
+	set size [$f.var.size.entry get]
+	if [regexp {^[0-9]+$} $size] {set @size $size}
+	$self font_update $f
+}
+
+def FontDialog apply {} {
+	set ::look($@class:font) $@str
+	$@orig configure -font [lreplace $@str 1 1 -10] -text $@str -width [string length $@str]
+}
+
+############ .pdrc editor
+#Turns #rgb into 3 elem list of decimal vals.
+proc rgb2dec {c} {
+	set c [string tolower $c]
+	if {[regexp -nocase {^#([0-9a-f])([0-9a-f])([0-9a-f])$} $c x r g b]} {
+		# double'ing the value make #9fc == #99ffcc
+		scan "$r$r $g$g $b$b" "%x %x %x" r g b
+	} else {
+		if {![regexp {^#([0-9a-f]+)$} $c junk hex] || \
+			[set len [string length $hex]]>12 || $len%3 != 0} {
+			if {[catch {winfo rgb . $c} rgb]} {
+				return -code error "bad color value \"$c\""
+			} else {
+				return $rgb
+			}
+		}
+		set len [expr {$len/3}]
+		scan $hex "%${len}x%${len}x%${len}x" r g b
+	}
+	return [list $r $g $b]
+}
+#Returns a complementary color
+proc complement {orig {grays 1}} {
+	foreach {r g b} [rgb2dec $orig] {break}
+	set R [expr {(~$r)%256}]
+	set G [expr {(~$g)%256}]
+	set B [expr {(~$b)%256}]
+	if {$grays && abs($R-$r) < 32 && abs($G-$g) < 32 && abs($B-$b) < 32} {
+		set R [expr {($r+128)%256}]
+		set G [expr {($g+128)%256}]
+		set B [expr {($b+128)%256}]
+	}
+	return [format "\#%02x%02x%02x" $R $G $B]
+}
+
+# this makes the tooltip
+proc balloon {w help} {
+	bind $w <Any-Enter> "after 500 [list balloon:show %W [list $help]]"
+	#bind $w <Any-Leave> "destroy %W.balloon; puts \"destroy balloon\" "
+	bind $w <Any-Leave> "destroy %W.balloon"
+}
+
+proc balloon:show {w arg} {
+	if {[eval winfo containing  [winfo pointerxy .]]!=$w} {return}
+	set top $w.balloon
+	catch {destroy $top}
+	toplevel $top -bd 1 -bg black
+	wm overrideredirect $top 1
+	if {$::tcl_platform(platform) == "macintosh"} {
+		unsupported1 style $top floating sideTitlebar
+	}
+	pack [message $top.txt -aspect 10000 -bg lightyellow -font fixed -text $arg]
+	set wmx [expr [winfo rootx $w]+[winfo width $w]]
+	set wmy       [winfo rooty $w]
+	wm geometry $top [winfo reqwidth $top.txt]x[winfo reqheight $top.txt]+$wmx+$wmy
+	raise $top
+}
+
+def Dialog ok     {} {$self apply; $self cancel}
+def Dialog cancel {} {if {[info exists @nbs]} {foreach x $@nbs {$x delete}}; after 1 [list $self delete]}
+def Dialog close  {} {$self delete}
+def Dialog apply  {} {}
+def Dialog delete {} {destroy .$self; super}
+def Dialog erase {} {}; # so that it doesn't call View erase
+
+def Dialog init {args} {
+	super
+	set f .$self
+	set @label_width 160 ;# 20
+	toplevel $f
+	frame $f.buttonsep -height 2 -borderwidth 1 -relief sunken
+	frame $f.buttonframe
+	set i 0
+	foreach a $args {
+		if {[llength $args]<=1 || $i>0} {
+			pack [label $f.buttonframe.$i -width 1] -side left -fill x -expand 1
+		}
+		pack [button $f.buttonframe.$a -text [say $a] -command "$self $a"] -side left
+		bind $f.buttonframe.$a <Return> "$self $a"
+		incr i
+	}
+	pack $f.buttonframe -side bottom -fill x -pady 2m
+	pack $f.buttonsep   -side bottom -fill x
+	wm protocol $f WM_DELETE_WINDOW "$self cancel"
+	bind .$self         <Tab> "$self traversal %K %W forward"
+	bind .$self <Control-Tab> "$self traversal %K %W back"
+}
+
+def Dialog none_resizable {} {wm resizable .$self 0 0}
+
+def Dialog traversal {k w direction} {
+	switch $direction {
+		forward {focus [tk_focusNext $w]}
+		back    {focus [tk_focusPrev $w]}
+	}
+}
+
+def Dialog dropmenu_open {frame} {
+	set x [winfo rootx $frame.butt]
+	set y [expr [winfo height $frame.butt] + [winfo rooty $frame.butt]]
+	tk_popup $frame.menu $x $y
+}
+
+def Dialog dropmenu_set {frame var part val} {
+	#if {$say} {set text [say $part]} else {set text $part}
+	set @$var $val
+	$frame.butt configure -text [say $part]
+}
+
+def Dialog color_popup_select {frame var color} {
+	set @$var $color
+	set col [format #%6.6x $color]
+	if {$self == "ddrc"} {set @$var $col}
+	$frame.color configure -background $col -foreground [complement $col] -text $col
+	if {$self != "ddrc"} {$self do_auto_apply}
+	#$self do_auto_apply
+}
+
+def Dialog color_popup {frame var i} {
+	set w $frame.color.popup
+	if [winfo exists $w] {destroy $w}
+	menu $w -tearoff false
+	global preset_colors
+	for {set i 0} {$i<[llength $preset_colors]} {incr i} {
+		set c [lindex $preset_colors $i]
+		$w add command -label "     " -background "#$c" -activebackground "#$c" \
+		    -command [list $self color_popup_select $frame $var [expr 0x$c]]
+	}
+	tk_popup $w [expr [winfo rootx $frame.color]] [expr [winfo rooty $frame.color]]
+}
+
+def Dialog choose_col {frame var val} {
+	set c 0xFFFFFF
+	set color [tk_chooseColor -title $val -initialcolor $val]
+	if {$color != ""} {
+		$frame.color configure -text $color
+		$self color_popup_select $frame $var [expr [string replace $color 0 0 "0x"]&0xFFFFFF]
+	}
+}
+
+class_new PagedDialog {Dialog}
+class_new Notebook    {Thing}
+
+def PagedDialog init {args} {
+	eval [concat [list super] $args]
+	set @nb [Notebook new_as $self.1]
+	set @nbs $@nb
+	pack .$@nb -expand 1 -fill both
+	$self none_resizable
+}
+def Notebook delete {} {super}
+def Notebook init {{width 590} {height 350}} {
+	set f .$self
+	frame $f
+	pack [frame $f.bar] -fill x
+	pack [frame $f.main -borderwidth 1 -relief raised -width $width -height $height] -fill both -expand yes
+}
+
+def Notebook page_select {i} {
+	set f .$self
+	catch {
+		$f.bar.$@section configure -relief raised
+		place forget $f.main.$@section
+		pack $f.bar.$@section -pady {4 4}
+	}
+	set @section $i
+	place $f.main.$@section -x 0 -y 0 ;# -width [winfo width $f.main] -height [winfo height $f.main]
+	$f.bar.$@section configure -relief sunken
+	pack $f.bar.$@section -pady {8 0}
+}
+
+def Notebook add_section {section text} {
+	set f .$self
+	frame $f.main.$section
+	pack [button $f.bar.$section -text $text -command [list $self page_select $section]] -side left -pady {4 4}
+	bind $f.bar.$section <Return> "$self page_select $section"
+}
+
+# numbers in section are for the % of space taken by labels
+set pdrc_options {
+	section {section_audio 50}
+	integer -r
+	devlist -audioindev|-soundindev
+	devlist -audiooutdev|-soundoutdev
+	spins {-inchannels audioindev}
+	spins {-outchannels audiooutdev}
+	integer -audiobuf|-soundbuf
+	integer -blocksize
+	integer -sleepgrain
+	void -nodac
+	void -noadc
+	choice {audio_api_choice}
+	void -32bit
+
+	section {section_midi 50}
+	void -nomidiin
+	void -nomidiout
+	devlist -midiindev
+	devlist -midioutdev
+
+	section {section_externals 20}
+	libraries -lib
+
+	section {section_paths 20}
+	folders -path
+	folders -helppath
+
+	section {section_other 50}
+	files -open
+	void -verbose
+	integer -d
+	void -noloadbang
+	string -send
+	void -listdev
+	void -realtime|-rt
+}
+
+proc pdtk_audio_dialog {indevlist indevs inchans outdevlist outdevs outchans sr dspblock advance multi longform} {
+	pdrc audio_properties $indevlist $indevs $inchans $outdevlist $outdevs $outchans $sr $dspblock $advance $multi
+}
+
+class_new ServerPrefsDialog {PagedDialog}
+
+def ServerPrefsDialog apply {} {
+	set audio_props [$self audio_properties=?]
+	#pd pd audio-dialog $audio_props
+	netsend [list "pd" "audio-dialog" $audio_props]
+	$self write
+}
+
+def ServerPrefsDialog init_reverse_hash {} {
+	global pdrc_options pdrc_options_h pd_apilist2
+	foreach {type names} $pdrc_options {
+		set name [lindex $names 0]
+		if {[info exists @$name]} {
+			if {$name != "audio_api_choice"} {set @$name ""}
+		} else {
+			set @$name ""
+		}
+		foreach alias $names {set pdrc_options_h($alias) [list $type $name]}
+		if {$name == "audio_api_choice"} {
+			foreach alias [lrange $pd_apilist2 1 end] {set pdrc_options_h($alias) [list $type $name]}
+		}
+	}
+}
+
+def ServerPrefsDialog audio_properties {indevlist indevs inchans outdevlist outdevs outchans sr dspblock advance multi} {
+	set @audioindev $indevlist
+	set @audiooutdev $outdevlist
+	# the following @audioindev* is used as -textvariable for devlist
+	set @audioindev0  [lindex $@audioindev 0]
+	set @audiooutdev0 [lindex $@audiooutdev 0]
+	set @inchannels $inchans
+	set @outchannels $outchans
+	set @audiobuf $advance
+	set @blocksize $dspblock
+	set @usemulti $multi
+	set @r $sr
+	set @midiindev "midione"
+	set @midioutdev "miditwo"
+	# below are also used as -textvariable
+	mset [list @inchannels0  @inchannels1  @inchannels2  @inchannels3]  $@inchannels
+	mset [list @outchannels0 @outchannels1 @outchannels2 @outchannels3] $@outchannels
+	set @audio_api_choice2 [say [lindex $::pd_apilist2 $@audio_api_choice]]
+	if {![winfo exists .$self.1.main.1]} {
+		$self init_content
+	} else {
+		$self update_content
+	}
+}
+
+def ServerPrefsDialog audio_properties=? {} {
+	set indev0 [lsearch $@audioindev $@audioindev0]
+	set outdev0 [lsearch $@audiooutdev $@audiooutdev0]
+	return [list $indev0  0 0 0  $@inchannels0  $@inchannels1  $@inchannels2  $@inchannels3 \
+		     $outdev0 0 0 0 $@outchannels0 $@outchannels1 $@outchannels2 $@outchannels3 \
+	             $@r $@blocksize $@audiobuf]
+}
+
+def ServerPrefsDialog read_one {type name contents i} {
+	switch -- $type {
+		folders   {incr i; lappend @$name [lindex $contents $i]}
+		libraries {incr i; lappend @$name [lindex $contents $i]}
+		files     {incr i; lappend @$name [lindex $contents $i]}
+		choice    {
+			if {$name == "audio_api_choice"} {
+				if {$@$name == ""} {
+				set @$name [lsearch $::pd_apilist2 [lindex $contents $i]]
+				}
+			} else {
+				set @$name [lindex $contents $i]
+			}
+		}
+		void      {        set @$name 1}
+		default   {incr i; set @$name [lindex $contents $i]}
+	}
+	incr i
+	return $i
+}
+
+def ServerPrefsDialog read {} {
+	global pdrc_options pdrc_options_h cmdline
+	set fd [open $cmdline(rcfilename) "RDONLY CREAT"]
+	set contents {}
+	foreach line [split [read $fd] "\n"] {
+		if {[string index $line 0] != "#"} {lappend contents $line}
+	}
+	close $fd
+	set contents [concat [join $contents " "]] ;# concat casts to list type (faster) (?)
+	set i 0
+
+	# prevent Tk8.5 from showing grey checkmarks
+	foreach name {-nodac -noadc -32bit -nomidiin -nomidiout -verbose -noloadbang -listdev -realtime} {
+		set _($self:$name) 0
+	}
+
+	while {$i < [llength $contents]} {
+		set op [lindex $contents $i]
+		if {[string length $op]==0} {break}
+		if {![info exists pdrc_options_h($op)]} {
+			post "unknown option: %s" $op
+			incr i
+			continue
+		}
+		mset {type name} $pdrc_options_h($op)
+		set name [lindex [split $name "|"] 0]
+		set i [$self read_one $type $name $contents $i]
+	}
+}
+
+def ServerPrefsDialog write {} {
+	set fd [open $::cmdline(rcfilename) w]
+	#set fd stdout; puts "WOULD SAVE:"
+	foreach {type names} $::pdrc_options {
+		set name [lindex [split [lindex $names 0] "|"] 0]
+		if {[info exists _($self:$name)]} {set v $_($self:$name)} ;# bug in objective.tcl ?
+		switch $type {
+			folders   {foreach item [$v get 0 end] {puts $fd "$name $item"}}
+			libraries {foreach item [$v get 0 end] {puts $fd "$name $item"}}
+			#files    {foreach item $v {puts $fd "$name $item"}}
+			void      {if {$v != ""} {if {$v} {puts $fd $name}}}
+			choice    {
+				if {$name != "audio_api_choice"} {
+					set vv [lindex $names [expr 1+$v]]
+					if {$vv != "default"} {puts $fd $vv}
+				} else {
+					set vv [lindex $::pd_apilist2 $v]
+					if {$vv != "default"} {puts $fd $vv}
+				}
+			}
+			devlist {}
+			default   {if {[string length $v]} {puts $fd "$name $v"}}
+		}
+	}
+	close $fd
+	#puts "THE END"
+}
+def ServerPrefsDialog reset {} {
+}
+
+def ServerPrefsDialog init_content {} {
+	global pdrc_options
+	set f .$self.1
+	set section 0
+	set @label_width 200 ;# 24
+	foreach {type names} $pdrc_options {
+		set name [lindex [split [lindex $names 0] "|"] 0]
+		switch $type { void { set type toggle }}
+		switch $type {
+			section {
+				set @label_width [expr 6*[lindex $names 1]] ;# % of 600 px
+				$@nb add_section [incr section] [say $name]
+			}
+			choice  {
+				if {$name == "audio_api_choice"} {
+					set ops $::pd_apilist2
+				} else {
+					set ops [lrange $names 1 end]
+				}
+				$self add $f.main.$section [list $name choice -choices $ops]
+			}
+			devlist {$self add $f.main.$section [list $name devlist] }
+			spins {$self add $f.main.$section [list $name spins [lindex $names 1]] }
+			default {$self add $f.main.$section [list $name $type]}
+		}
+	}
+	$@nb page_select 1
+}
+
+def ServerPrefsDialog update_content {} {
+	$self update_channels
+}
+
+def ServerPrefsDialog update_channels {} {
+	set indev_len [llength $@audioindev]
+	set outdev_len [llength $@audiooutdev]
+	set i 0
+	foreach chan $@inchannels {
+		if {$i < $indev_len} {set s "readonly"} else {set s "disabled"}
+		.$self.1.main.1.-inchannels.$i configure -state $s
+		incr i
+	}
+	set i 0
+	foreach chan $@outchannels {
+		if {$i < $outdev_len} {set s "readonly"} else {set s "disabled"}
+		.$self.1.main.1.-outchannels.$i configure -state $s
+		incr i
+	}
+}
+
+def ServerPrefsDialog init {} {
+	netsend [list pd audio-properties]
+	$self init_reverse_hash
+	$self read
+	super reset cancel apply ok
+	# pd pd  midi-properties
+}
+
+def ServerPrefsDialog dropmenu_set {frame var part val} {
+	set trim_part [string trimleft $part "-"]
+	set trim_var [string trimleft $var "-"]
+	if {$var == "audio_api_choice"} {
+		foreach api $::pd_apilist {
+			if {$trim_part == [string tolower [lindex $api 0]]} {
+				netsend [list pd audio-setapi [lindex $api 1]]
+				after 1 [netsend [list pd audio-properties]]
+			}
+		}
+	} else {
+		set ::_($self:${trim_var}0) $part
+	}
+	super $frame $var $part $val
+}
+#used by choice and devlist
+def ServerPrefsDialog dropmenu_open {f name} {
+	set trim_name [string trimleft $name "-"]
+	if {$trim_name != "audio_api_choice"} {
+		set i 0
+		set m $f.menu
+		$m delete 0 end
+		foreach part $@$trim_name {
+			$m add command -label $part -command [list $self dropmenu_set $f $name $part $i]
+			incr i
+		}
+	}
+	super $f
+}
+
+#################### ClientPrefsDialog
+set ddrc_options {
+section Client section_color
+  subsection Client canvas_color
+    color Canvas bgedit
+    color Canvas bgrun
+    color Canvas grid
+  subsection Client object_color
+    color View bg
+    color View fg
+    color View frame1
+    color View frame2
+    color View frame3
+    color Comment bg
+    color Comment fg
+    color Comment frame1
+    color Comment frame2
+    color Comment frame3
+    color View selectframe
+    font View font
+  subsection Client wire_color
+    color Wire fg
+    color Wire dspfg
+    color Wire fg2
+    color FutureWire dash
+  subsection Client others_color
+    color Box inletfg
+    color Box outletfg
+    color SelRect rect
+    font KeyboardDialog font
+    font Console font
+section Client keys
+  subsection Client put
+    key Canvas Object
+    key Canvas Message
+    key Canvas {Number nbx}
+    key Canvas Symbol
+    key Canvas Comment
+    key Canvas bng
+    key Canvas tgl
+    key Canvas {vsl hsl}
+    key Canvas {vradio hradio}
+    key Canvas vu
+    key Canvas cnv
+    key Canvas Graph
+    key Canvas Array
+  subsection Client edit
+    key Canvas {cut copy}
+    key Canvas {undo redo}
+    key Canvas {paste duplicate}
+    key Canvas select_all
+    key Canvas clear_selection
+    key Canvas {reload redraw}
+    key Canvas editmodeswitch
+    key Canvas {insert_object chain_object}
+    key Canvas {clear_wires auto_wire}
+    key Canvas subpatcherize
+  subsection Client general
+    key Canvas Pdwindow
+    key Canvas {new_file open_file}
+    key Canvas {save save_as}
+    key Client {server_prefs client_prefs}
+    key Canvas {close quit}
+    key Canvas {find find_again}
+    key Canvas {audio_on audio_off}
+    key Client {audio_settings midi_settings}
+    key Client test_audio_and_midi
+    key Canvas {load_meter latency_meter}
+    key Canvas about
+  subsection Canvas keynav
+    key Canvas {key_nav_up key_nav_up_shift}
+    key Canvas {key_nav_down key_nav_down_shift}
+    key Canvas {key_nav_right key_nav_right_shift}
+    key Canvas {key_nav_left key_nav_left_shift}
+    key Canvas key_nav_ioselect
+section Client others
+    toggle Canvas hairstate
+    toggle Canvas hairsnap
+    toggle Canvas gridstate
+    integer Canvas grid_size
+    toggle Canvas snap_grid
+    toggle Canvas buttonbar
+    toggle Canvas statusbar
+    toggle Canvas menubar
+    toggle Canvas scrollbar
+    toggle View tooltip
+    toggle Wire wirearrow
+    integer Client console
+    choice View language
+    integer Canvas pointer_sense
+}
+
+class_new ClientPrefsDialog {PagedDialog}
+def ClientPrefsDialog apply {} {$self write; $self do_apply}
+def ClientPrefsDialog read {} {read_ddrc}
+
+def ClientPrefsDialog do_apply {} {
+	foreach canvas $::window_list {
+		if {[$canvas class] == "Canvas"} {
+			$canvas activate_menubar= [$canvas look menubar]
+			$canvas activate_buttonbar= [$canvas look buttonbar]
+			$canvas activate_statusbar= [$canvas look statusbar]
+			$canvas activate_scrollbars= [$canvas look scrollbar]
+			$canvas activate_grid= [$canvas look gridstate]
+			$canvas redraw
+		}
+	}
+}
+
+def ClientPrefsDialog write {} {
+	global look key
+	$self get_val
+	set fd [open $::cmdline(ddrcfilename) w]
+	foreach category {look key} {
+		set class_list {}
+		puts $fd "$category \{"
+		foreach name [array names $category] {
+			mset {class var} [split $name ":"]
+			lappend class_list $class
+		}
+		set class_list [luniq [lsort $class_list]]
+		foreach class $class_list {
+			puts $fd "  $class \{"
+			foreach name [lsort [array names $category -glob $class:*]] {
+				mset {class var} [split $name ":"]
+				# the eval here annoys me a bit because of possible special chars -- matju
+				puts $fd "    $var [eval list \$${category}($class:$var)]"
+				#puts " $var $category $class $var"
+			}
+			puts $fd "  \}"
+		}
+		puts $fd "\}"
+	}
+	close $fd
+}
+
+#this retrieves the values set in the editor
+def ClientPrefsDialog get_val {} {
+	global ddrc_options look key accels
+	set check_key {}
+	foreach {type class name} $ddrc_options {
+		switch $type {
+			color {
+				set str [string tolower $class$name]
+				set look($class:$name) $@$str
+			}
+			key {
+				foreach item $name {
+					set new_key $@$item
+					set old_key $key($class:$item)
+					if {$key($class:$item) != $new_key} {
+						if {[dict exists $accels $old_key]} {
+							set cmd [dict get $accels $old_key]
+							set accels [dict remove $accels $old_key]
+							dict set accels $new_key $cmd
+						}
+					}
+					if {[dict exists $check_key $new_key] && $new_key != ""} {
+						error "$new_key already assigned"
+					} else {dict set check_key $new_key key($item)}
+					set key($class:$item) $new_key
+				}
+			}
+			toggle { set look($class:$name) $@$name}
+			integer {set look($class:$name) $@$name}
+			choice  {set look($class:$name) $@$name}
+			#font {set look(View:font) $@str}
+		}
+	}
+}
+
+def ClientPrefsDialog reset {} {
+	# this should reload defaults.ddrc ?
+}
+
+def ClientPrefsDialog revert {} {
+	# this should reload currently used settings ?
+}
+
+def ClientPrefsDialog init {} {
+	global ddrc_options look key
+	#do we need to read .ddrc each time the pref editor is opened?
+	#$self read
+	super cancel apply ok
+	#super cancel reset revert apply ok
+	set f .$self.1
+	set section 0
+	set subsection 0
+	set @label_width 200 ;# 24
+
+	foreach {type class names} $ddrc_options {
+		set name [lindex [split $names |] 0]
+		switch $type { void { set type toggle }}
+		switch $type {
+			section {
+				$@nb add_section [incr section] [say $name]
+				set which_section $f.main.$section
+				set which_self $self
+				set subsection 0
+			}
+			subsection {
+				set subself $self.1.main.$section.subsections
+				if {!$subsection} {
+					lappend @nbs [Notebook new_as $subself 590 300]
+					pack .$subself
+				}
+				$subself add_section [incr subsection] [say $name]
+				$subself page_select 1
+				set which_section .$subself.main.$subsection
+				set which_self $subself
+			}
+			choice {
+				set @$name $look(View:language)
+				$self add $which_section [list $name $type -choices $::langoptions]
+			}
+			color {
+				set str [string tolower $class$name]
+				set @$str $look($class:$name)
+				$self add $which_section [list $str $type]
+			}
+			key {
+				foreach item $name {
+					set @$item $key($class:$item)
+				}
+				$self add $which_section [list $name $type]
+			}
+			toggle {
+				set @$name $look($class:$name)
+				$self add $which_section [list $name $type]
+			}
+			font {
+				set str [string tolower $class$name]
+				set @$str $look($class:$name)
+				$self add $which_section [list $str $type $class]
+			}
+			default {
+				switch $name {
+					console {set @$name $look(Client:console)}
+					pointer_sense {set @$name $look(Canvas:pointer_sense)}
+					grid_size {set @$name $look(Canvas:grid_size)}
+					default {}
+				}
+				$self add $which_section [list $name $type]
+			}
+		}
+	}
+	$@nb page_select 1
+}
+
+def ClientPrefsDialog dropmenu_set {frame var part val} {
+	set @$var $part
+	# set _($self:${var}2) [say $part]
+	$frame.butt configure -text [say $part]
+}
+
+def ClientPrefsDialog dropmenu_open {f name} {
+	super $f
+}
+
+############ find dialog ###########
+
+class_new FindDialog {Dialog}
+
+def FindDialog init {canvas} {
+	super cancel find
+	set @canvas $canvas
+	set @break 0
+	set f .$self
+	$self add $f [list "string" "entry"]
+	focus .find.string.entry
+}
+
+def FindDialog find {} {$self ok}
+def FindDialog ok {} {
+	$@canvas find_string= $@string
+	$@canvas search
+	super
+}
+############ other stuff #########
+
+def Client client_class_tree {} {ClientClassTreeDialog new}
+class_new ClientClassTreeDialog {Dialog}
+
+proc* place_stuff {args} {}
+
+def ClientClassTreeDialog make_row {w tree} {
+	pack [frame $w] -fill x
+	pack [frame $w.row] -side top -fill x
+	pack [button $w.row.butt -image icon_minus] -side left
+	pack [label $w.row.label -text [lindex $tree 0]] -side left -fill x
+	pack [frame $w.dent -width 32] -side left
+	set i 1
+	foreach node [lrange $tree 1 end] {
+		$self make_row $w.$i $node
+		incr i
+	}
+}
+
+def ClientClassTreeDialog init {} {
+	super close
+	pack [frame .$self.1   -width 600 -height 400] -fill y -expand y
+	pack [frame .$self.1.1 -width 600 -height 400 -bg "#6688aa"] -side left -fill y -expand y
+	# "$w.1.scroll set"
+	# i'd like a scrollable frame
+	pack [scrollbar .$self.1.scroll -command "ClientClassTreeDialog_scroll $self"] -side left -fill y -expand y
+	place [frame .$self.1.1.tree] -x 0 -y 0
+	set w .$self.1.1.tree.1
+	$self make_row $w [Thing get_hierarchy]
+	after 100 "$self update_scrollbar"
+}
+
+def ClientClassTreeDialog update_scrollbar {} {
+	set w .$self.1.1
+	set zy [winfo height $w]
+	set sy [winfo height $w.tree]
+	set y1 [expr   0.0-[winfo y $w.tree]]
+	set y2 [expr   0.0+$y1+$zy]
+	.$self.1.scroll set [expr $y1/$sy] [expr $y2/$sy]
+}
+
+def ClientClassTreeDialog scroll {args} {
+	set w .$self.1.1
+	set zy [winfo height $w]
+	set sy [winfo height $w.tree]
+	switch [lindex $args 0] {
+		moveto {
+			set y [clip [expr (0.0-[lindex $args 1])*$sy] [expr $zy-$sy] 0]
+			place .$self.1.1.tree -x 0 -y $y
+			puts "args=[list $args] zy=$zy sy=$sy y=$y"
+		}
+		scroll {
+		}
+	}
+	after 100 "$self update_scrollbar"
+}
+
+class_new AboutDialog {Dialog}
+
+def AboutDialog init {} {
+	super close
+        wm title .$self "About DesireData"
+        pack [label .$self.title -text $::pd_version -font {helvetica 18}] -side top
+	pack [text .$self.text -yscrollcommand ".$self.scroll set" -width 72 -height 36] -side left -fill both -expand yes
+	pack [scrollbar .$self.scroll -command ".$self.text yview"] -side right -fill y -expand yes
+#12345678901234567890123456789012345678901234567890123456789012345678901 <- 72 chars
+	.$self.text insert 0.0 \
+"DesireData is a free (libre) real-time computer programming language
+interpreter focused on realtime audio and video.
+You can get DesireData from http://desiredata.goto10.org/
+
+DesireData and PureData work on Linux, MacOSX, Windows, and others.
+
+PureData is copyrighted, but is free for you to use for any reasonable
+purpose, according to the SIBSD license. DesireData's client section
+also is free, according to the GPL license. DesireData's server section
+is an adaptation of the PureData code and is also using the SIBSD
+license.
+
+(insert here: links to both licenses)
+
+Credits:
+  DesireData server: Mathieu Bouchard
+  DesireData client: Mathieu Bouchard & Chun Lee
+  PureData: Miller Puckette feat. Thomas Musil,
+  Günther Geiger, Krzysztof Czaja, Iohannes Zmölnig & others.
+
+  Translations:
+    Français (French): Patrice Colet
+    Català (Catalan): Núria Verges
+    Español (Spanish): Mario Mora, Ramiro Cosentino
+    Deutsch (German): Max Neupert, Georg Holzmann, Thomas Grill
+    Norsk Bokmål (Norwegian): Gisle Frøysland
+    Português (Portuguese): Nuno Godinho
+    Italiano (Italian): Davide Morelli, Federico Ferri
+    Euskara (Basque): Ibon Rodriguez Garcia
+    Nihongo (Japanese): Kentaro Fukuchi
+    Polski (Polish): Michal Seta
+    Dansk (Danish): Steffen Leve Poulsen
+    Zong wen (Chinese): Chun Lee
+    Nederlands (Dutch): Tim Vets
+    Türkçe (Turkish): Koray Tahiroglu
+    Russkij (Russian): Ilya Dmitrichenko
+
+Much more documentation and other resources at http://puredata.info/
+The Pd mailing list archive at http://lists.puredata.info/pipermail/pd-list/
+
+(insert here: link to \"reference documentation for Pd\", that is, chapter 1)"
+
+	# this looks bad on OSX, iirc
+	.$self.text configure -state disabled
+}
+
+set manager [Manager new]
+
+def Class post_hierarchy {{i 0}} {
+	post %*s%s [expr $i*2] "" $self
+	foreach sub $@subclasses {$sub post_hierarchy [expr $i+1]}
+}
+def Class get_hierarchy {} {
+	set l [list $self]
+	foreach sub $@subclasses {lappend l [$sub get_hierarchy]}
+	return $l
+}
+
+# Thing post_hierarchy
+
+#----------------------------------------------------------------
+class_new ClipboardDialog {Dialog}
+
+def ClipboardDialog init {clipboard} {
+	super close
+	set @clipboard $clipboard
+        wm title .$self "Clipboard"
+	pack [text .$self.text -yscrollcommand ".$self.scroll set" -width 72
+	     ] -side left -fill both -expand yes
+	pack [scrollbar .$self.scroll -command ".$self.text yview"] -side right -fill y
+	$@clipboard subscribe $self
+	$self notice
+}
+
+def ClipboardDialog notice {args} {
+	.$self.text delete 0.0 end
+	.$self.text insert 0.0 [$@clipboard value]
+}
+
+def ClipboardDialog delete {} {
+	$@clipboard unsubscribe $self
+	super
+}
+
+#----------------------------------------------------------------
+class_new ListDialog {Dialog}
+
+def ListDialog init {history title} {
+	super close
+	set @history $history
+	wm title .$self $title
+	frame .$self.1
+	pack [listbox .$self.1.list -yscrollcommand ".$self.1.scroll set" -width 72 -height 20] -side left -fill both -expand yes
+	pack [scrollbar .$self.1.scroll -command ".$self.1.list yview"] -side right -fill y
+	pack .$self.1
+	$@history subscribe $self
+	$self notice
+}
+
+def ListDialog listbox {} {return .$self.1.list}
+
+def ListDialog notice {args} {
+	set w [$self listbox]
+	$w delete 0 end
+	foreach e [$@history list] {$w insert end $e}
+	$w see end
+}
+
+def ListDialog delete {} {
+	$@history unsubscribe $self
+	super
+}
+
+class_new EventHistoryDialog {ListDialog}
+
+def EventHistoryDialog init {history} {
+	super $history [say event_history_view]
+	pack [checkbutton .$self.hide -text [say hide_key_release]] -fill x
+	[$self listbox] configure -font {Mono -10}
+}
+
+#----------------------------------------------------------------
+#class_new Splash {Thing}
+
+#def Splash init {} {
+#	toplevel .$self
+#	frame .$self.f
+#	canvas .$self.f.canvas
+#	image create photo .dd -format GIF -file desiredata.gif
+#	.$self.f.canvas create image 0 0 -image .dd
+#	pack .$self.f.canvas
+#	pack .$self.f
+#}
+
+class_new KeyboardDialog {Dialog}
+
+set keyboard_layouts {
+    {
+	{9 " " 67 68 69 70 " " 71 72 73 74 " " 75 76 95 96}
+	{49 10 11 12 13 14 15 16 17 18 19 20 21 22}
+	{23 24 25 26 27 28 29 30 31 32 33 34 35 51}
+	{66 38 39 40 41 42 43 44 45 46 47 48 36}
+	{50 52 53 54 55 56 57 58 59 60 61 62}
+	{37 115 64 65 113 116 117 109}
+    } {
+	{" " " " 98 " "}
+	{100 " " " " 102}
+	{" " " " 104 " "}
+	{" "}
+        {" " " " 4 " "}
+	{1 2 3}
+        {" " " " 5 " "}
+    }
+}
+
+foreach {k v} {
+	9 5
+	22 5
+	23 4 51 4
+	66 5 36 7
+	50 8 62 8
+	37 4 115 4 64 4 65 24 113 4 116 4 117 4 109 4
+        98 2 100 2 102 2 104 2
+	1 2 2 2 3 2 4 2 5 2
+} {set keyboard_width_of($k) $v}
+
+proc namekey {i args} {foreach name $args {set ::keyboard_text_of($i) $name; incr i}}
+namekey 9 Esc
+namekey 67 F1 F2 F3 F4 F5 F6 F7 F8 F9 F10
+namekey 95 F11 F12
+namekey 49 `
+namekey 10 "1 !" "2 @" "3 #" "4 \$" "5 %" "6 ^" "7 &" "8 *" "9 (" "0 )" "- _" "= +" BkSp
+namekey 23 Tab Q W E R T Y U I O P "\{ \[" "\} \]"
+namekey 51 "\\ |"
+namekey 66 Caps
+namekey 38 A S D F G H J K L "\; :" "' \""
+namekey 36 Return
+namekey 50 Shift
+namekey 52 Z X C V B N M ", <" ". >" "/ ?" Shift
+namekey 37 Ctrl
+namekey 115 Sup
+namekey 64 Alt Space
+namekey 113 AltGr
+namekey 116 Sup Menu
+namekey 109 Ctrl
+namekey 98 (up)
+namekey 100 (left)
+namekey 102 (right)
+namekey 104 (down)
+namekey 1 1 2 3 4 5
+#mouse clicks
+
+def KeyboardDialog init {history} {
+	super close
+	set @history $history
+	set @fade [dict create]
+	wm title .$self "Keyboard View" ;# say
+	set i 0; set j 0
+	set @names {key misc}
+	frame .$self.board
+	set layouts {::keyboard_layout ::keyboard_layout2}
+	set @keycount 0
+	foreach layout $::keyboard_layouts {
+		$self pack_keys $layout [lindex $@names $i] [llength [lindex $::keyboard_layouts [expr $i-1]]]
+		incr i
+	}
+	pack .$self.board
+	$@history subscribe $self
+	$self fade
+}
+
+def KeyboardDialog pack_keys {keys name off} {
+	set i $off
+	frame .$self.board.$name
+	foreach row $keys {
+		frame .$self.board.$name.$i
+		foreach key $row {
+			if {$key==" "} {
+				pack [label .$self.board.$name.$i.shim$@keycount -image icon_empty] -side left
+				incr @keycount
+				continue
+			}
+			set ::keyboard_row_of($key) $i
+			if {[info exists ::keyboard_width_of($key)]} {
+				set width $::keyboard_width_of($key)
+			} else {set width 3}
+			if {[info exists ::keyboard_text_of($key)]}  {
+				set text  $::keyboard_text_of($key)
+			} else  {set text $key}
+			if {[regexp {\((\w+)\)} $text foo bar]} {
+				set font [$self look font]
+				pack [label .$self.board.$name.$i.key$key -image icon_$bar -relief raise -border 4 -bg \
+					"#dddddd" -width [expr $width*[font measure $font 0]] \
+					-height [font metrics $font -linespace]] -side left
+			} else {
+				pack [label .$self.board.$name.$i.key$key -text " $text " -relief raise -border 4 \
+				  	-bg "#dddddd" -width $width -font [$self look font]] -side left
+			}
+		}
+		pack .$self.board.$name.$i -fill x
+		if {$i==0} {pack [label .$self.board.$name.shim -image icon_empty] -fill x -expand yes}
+		incr i
+	}
+	switch $name {
+		key {pack .$self.board.key -side left}
+		misc {pack .$self.board.misc -side right}
+	}
+}
+
+def KeyboardDialog notice {origin add event} {
+	mset {type W x y mod K k} $event
+	if {![info exists ::keyboard_row_of($k)]} {puts "unknown key $k"; return}
+	set i $::keyboard_row_of($k)
+	if {$i<[llength [lindex $::keyboard_layouts 0]]} {set section "key"} else {set section "misc"}
+	switch -regexp -- $type {
+		^KeyPress|ButtonPress$   {
+			if { [dict exists $@fade $k]} {dict unset @fade $k}
+			.$self.board.$section.$i.key$k configure -bg "#ff0000"
+		}
+		^KeyRelease|ButtonRelease$ {if {![dict exists $@fade $k]} {dict set @fade $k 255}}
+	}
+}
+
+def KeyboardDialog fade {} {
+	foreach {k v} $@fade {
+		incr v -85
+		if {$v<0} {set v 0}
+		set r [expr 221+$v*2/15]
+		set g [expr 221-$v*13/15]
+		set i $::keyboard_row_of($k)
+		if {$i<[llength [lindex $::keyboard_layouts 0]]} {set section "key"} else {set section "misc"}
+		.$self.board.$section.$i.key$k configure -bg [format #%02x%02x%02x $r $g $g]
+		if {$v} {dict set @fade $k $v} {dict unset @fade $k}
+	}
+	set @after [after 100 "$self fade"]
+}
+
+def KeyboardDialog delete {} {
+  $@history unsubscribe $self
+  after cancel $@after
+  super
+}
+
+#----------------------------------------------------------------
+# Deconstructors
+
+def Wire deconstruct {{selcanvas ""}} {
+	# the selcanvas system could be abstracted out using an ObjectList such that
+	#   Canvas<ObjectList and $selection class == ObjectList
+	if {$selcanvas == ""} {
+		list #X connect \
+		    [[$@canvas objects] search $@from] $@outlet \
+		    [[$@canvas objects] search   $@to]  $@inlet
+	} {
+		list #X connect \
+		    $::obj_index_sel($@canvas:$@from) $@outlet \
+		    $::obj_index_sel($@canvas:$@to)   $@inlet
+	}
+}
+
+def MessageBox deconstruct {} {concat [list #X msg        $@x1 $@y1] $@text}
+def FloatBox   deconstruct {} {concat [list #X floatatom  $@x1 $@y1] $@w $@min $@max $@pos $@lab $@snd $@rcv}
+def SymbolBox  deconstruct {} {concat [list #X symbolatom $@x1 $@y1] $@w $@min $@max $@pos $@lab $@snd $@rcv}
+def Comment    deconstruct {} {concat [list #X text       $@x1 $@y1] $@text}
+
+
+def Box deconstruct {} {
+	if {[array names ::fields -exact $@pdclass] == ""} {
+		return [concat [list #X obj  $@x1 $@y1] $@text]
+	} {
+		set r {}
+		foreach field $::fields($@pdclass) {lappend r $_($self:$field)}
+		return $r
+	}
+}
+
+def View deconstruct_to {stream args} {
+	$stream << [philtre [eval [concat [list $self deconstruct] $args]]]
+	$stream << ";\n"
+}
+
+def Canvas deconstruct {} {
+	return [concat [list #X restore $@x1 $@y1] $@text]
+}
+def Canvas deconstruct_to {stream args} {
+	set r [concat [list #N canvas] $@canvas_pos $@canvas_size]
+	if {$@subpatch || $@abs} {lappend r $@name $@mapped} else {lappend r $@fontsize}
+	$stream << "[philtre $r];\n"
+	foreach i [lsort -integer [$@objects keys]] {eval [concat [list [$@objects get $i] deconstruct_to $stream]]}
+	foreach i [lsort -integer [  $@wires keys]] {eval [concat [list [  $@wires get $i] deconstruct_to $stream]]}
+	$stream << [philtre [eval [concat [list $self deconstruct] $args]]]
+	$stream << ";\n"
+}
+
+#----------------------------------------------------------------
+# openpanel & savepanel
+
+proc pdtk_openpanel {target localdir} {
+    if {$localdir == ""} {set localdir $::pd_opendir}
+    set filename [tk_getOpenFile -initialdir $localdir]
+    if {$filename != ""} {
+        set directory [string range $filename 0 [expr [string last / $filename]-1]]
+        set pd_opendir $directory
+        netsend [list $target callback [enquote $filename]]
+    }
+}
+
+proc pdtk_savepanel {target localdir} {
+    if {$localdir == ""} {
+    	set filename [tk_getSaveFile]
+    } else {
+    	set filename [tk_getSaveFile -initialdir $localdir]
+    }
+    if {$filename != ""} {
+        netsend [list $target callback [enquote $filename]]
+    }
+}
+
+#----------------------------------------------------------------
+# To err is human.
+
+#proc bgerror {err} {
+#	global errorInfo
+#	set info [error_dump]
+#	tk_messageBox -message "$err: $info" -type ok
+#}
+
+class_new OopsDialog {Dialog}
+
+def OopsDialog init {sig1 sig2 where} {
+	super damn
+	wm title .$self "Oops..."
+	pack [label .$self.head -text $sig2 -font {Helvetica -14 bold}] -side top
+	pack [label .$self.note -text "This program has performed a silly operation and has been shut down."] -side top
+	pack [text .$self.text -yscrollcommand ".$self.scroll set" -width 72 -height 15] -side left -fill both -expand 1
+	pack [scrollbar .$self.scroll -command ".$self.text yview"] -side right -fill y
+	.$self.text insert 0.0 $where
+}
+
+# Nous sommes donc en présence d'un incendie. C'est normal...
+def OopsDialog damn {} {$self ok}
+
+#----------------------------------------------------------------
+
+if {$tk} {
+	set main [Client new]
+	set window_list [list $main]
+} else {
+	set cmdline(console) 0
+	#foreach dir $auto_path {
+	#	set file $dir/libtclreadline[info sharedlibextension]
+	#	puts "trying $file"
+	#	if {![catch {load $file}]} {puts "found tclreadline !"}
+	#}
+	package require tclreadline
+	proc ::tclreadline::prompt1 {} {return "desire> "}
+	::tclreadline::Loop
+	#while {1} {
+	#	#set line [::tclreadline::readline read]
+	#	puts -nonewline "desire> "
+	#	flush stdout
+	#	set line [gets stdin]
+	#	if {[catch {puts [eval $line]}]} {
+	#		puts "error: $::errorInfo"
+	#	}
+	#}
+	#vwait foo
+}
+
+def Canvas auto_test {} {
+	$self editmode= 1
+	$self select_all
+	$self selection_move +10 0
+	$self selection_move +10 0
+	$self selection_move +10 0
+}
+
+#-----------------------------------------------------------------
+def Canvas visual_diff {} {
+	if {$@blinky != ""} {
+		after cancel $@blinky
+		return
+	}
+	#regsub {\.pd} [$self name] {} filename
+	set filename [$self name]
+	set initialfile ""
+        foreach suffix {gif jpg jpeg png} {
+	    set t [$self folder]/$filename.$suffix
+	    post %s $t
+	    if {[file exist $t]} {set initialfile $filename.$suffix; break}
+        }
+	set filename [tk_getOpenFile -defaultextension .pd -filetypes $::image_filetypes -initialdir [$self folder] -initialfile $initialfile]
+	if {$filename == ""} {return}
+	image create photo image_$self -file $filename
+	$self blink_image
+}
+
+def Canvas blink_image {} {
+	if {[llength [.$self.c gettags BLINKY]]} {
+		.$self.c delete BLINKY
+	} else {
+		.$self.c create image 0 0 -image image_$self -tag BLINKY -anchor nw
+	}
+	set @blinky [after 500 [list $self blink_image]]
+}
+
+#-----------------------------------------------------------------
+
+#lappend ::auto_path /usr/local/lib/graphviz
+catch {package require Tcldot}
+def Canvas graphviz_sort {} {
+	error "this code has to be rewritten to use the new containers"
+	set nodes {}
+	set gwidth 0; set gh 0
+	#toplevel .graph -height 600 -width 800
+	#set c [canvas .graph.c -height 600 -width 800]
+	#pack $c
+	set g [dotnew digraph]
+	$g setnodeattribute style filled color white
+	foreach child $@children {
+		lappend nodes [$g addnode $child label "[$child text]" shape "record" height "0.1"]
+		lappend nodes $child
+	}
+	puts "$nodes"
+	foreach wire $@wires {
+		mset {from outlet to inlet}  [$wire report]
+		set n1  [lindex $nodes [expr [lsearch $nodes $from]-1]]
+		set n2  [lindex $nodes [expr [lsearch $nodes   $to]-1]]
+		$n1 addedge $n2
+	}
+	#$g layout
+        ;# see what render produces
+	#if {$debug} {puts [$g render]}
+	#eval [$g render]
+	set f {}
+	set fd [open graph.txt w]
+	$g write $fd plain
+	close $fd
+
+	set fd [open graph.txt r]
+	set contents [read $fd]
+	close $fd
+	exec rm graph.txt
+	mset {x1 y1 x2 y2} [[$self widget] bbox all]
+	set width [expr $x2 - $x1]
+	set height [expr $y2 - $y1]
+	foreach line [split $contents "\n"] {
+		switch [lindex $line 0] {
+			graph {set gw [lindex $line 2]; set gh [lindex $line 3]}
+			node {
+				set w [expr $width/$gw]
+				set h [expr $height/$gh]
+				set id [lindex $line 1]
+				set x [lindex $line 2]; set y [lindex $line 3]
+				$id moveto [expr $x*$w] [expr ($gh-$y)*$h]
+			}
+			edge {break}
+		}
+	}
+}
+
+