Canvas moving objects and toggle tags

FF 2007-05-15 - This is part of my code snippets. Check my page for an index.
 set halo 2

 proc item:upd {w} {
 $w itemconfigure object -outline {}
 $w itemconfigure hover -outline red
 $w itemconfigure moveit -outline purple
 }

 proc item:move {w x y {init 0}} {
 global oldx oldy
 if $init {
  set oldx $x; set oldy $y
  $w addtag moveit closest $x $y $::halo
  $w dtag !moveable moveit
  $w raise moveit
 } else {
  $w move moveit [expr $x-$oldx] [expr $y-$oldy]
  set oldx $x; set oldy $y
 }
 item:upd $w
 }

 proc item:endmove {w x y} {
 $w dtag moveit
 item:upd $w
 }

 proc item:hover {w x y st} {
 if $st {
  $w addtag hover closest $x $y $::halo
  $w dtag !moveable hover
 } else {
  $w dtag hover
 }
 item:upd $w
 }

 proc item:toggletag {w x y tag} {
 set ttt tagtotoggle
 $w addtag $ttt closest $x $y $::halo $tag
 if {[lsearch [$w gettags $ttt] $tag] >= 0} {
  $w dtag ($ttt&&$tag) $tag
  item:hover $w $x $y 0
 } else {
  $w addtag $tag withtag ($ttt&&!$tag)
  item:hover $w $x $y 1
 }
 $w dtag $ttt
 }

 pack [canvas .c -width 200 -height 130 -background white]

 # some ugly test objects
 .c create polygon 10 10 10 40 18 10 -fill green -tags {object moveable}
 .c create polygon 50 50 60 50 60 60 50 60 -fill gray -tags {object moveable}
 .c create polygon 70 50 90 50 90 70 70 70 -fill blue -tags {object}

 # bind necessary actions
 .c bind moveable <ButtonPress-1> {item:move %W %x %y 1}
 .c bind moveable <ButtonRelease-1> {item:endmove %W %x %y}
 .c bind moveable <Enter> {item:hover %W %x %y 1}
 .c bind moveable <Leave> {item:hover %W %x %y 0}
 .c bind moveit <B1-Motion> {item:move %W %x %y}
 .c bind all <ButtonRelease-2> {item:toggletag %W %x %y moveable}

 # update item styles
 item:upd .c
Screenshots

gold added pix
Category Widget