[PD-cvs] pd/src desire.tk,1.1.2.600.2.184,1.1.2.600.2.185

[chunlee]

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

Modified Files:
      Tag: desiredata
	desire.tk 
Log Message:
playing with adding mode/extention support


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.600.2.184
retrieving revision 1.1.2.600.2.185
diff -C2 -d -r1.1.2.600.2.184 -r1.1.2.600.2.185
*** desire.tk	23 May 2007 13:50:28 -0000	1.1.2.600.2.184
--- desire.tk	25 May 2007 02:28:52 -0000	1.1.2.600.2.185
***************
*** 161,164 ****
--- 161,186 ----
  	}
  }
+ #-----------------------------------------------------------------------------------#
+ 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
+ 	dict for {mode callbacks} $callback_list {
+ 		foreach {when call} $callbacks {
+ 			if {$def == $when} {eval $self $call $args; return 1}
+ 		}
+ 	}
+ 	return 0
+ }
  
  #-----------------------------------------------------------------------------------#
***************
*** 2660,2663 ****
--- 2682,2686 ----
  
  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
***************
*** 3281,3284 ****
--- 3304,3308 ----
  	$f.cmd delete 0 end
  	post %s "returns: [uplevel [info level] [join [list $@canvas $text]]]"
+ 	$self delete
  }
  
***************
*** 3946,3954 ****
  		wire {$self click_on_wire $id $f $x $y}
  		nothing {
- 			if {[$self focus] != ""} {
  				$self click_on_nothing $f $target $x $y
  				return
- 			}
- 
  		}
  		label {$self click_on_object $id $f}
--- 3970,3975 ----
***************
*** 4378,4381 ****
--- 4399,4421 ----
  }
  
+ def Canvas keyboard-mode {} {
+ 	puts "loading keyboard-mode...."
+ 	if {[file exists kb-mode.tcl]} {
+ 		package require kb-mode
+ 		$@runcommand defs
+ 		kb-mode_init
+ 		puts "packages:::: [package names]"
+ 	}
+ }
+ 
+ def Canvas keyboard-mode-exit {} {
+ 	puts "exiting keyboard-mode...."
+ 	package forget kb-mode
+ 	remove_callback kb-mode
+ 	$@runcommand defs
+ 	puts "packages:::: [package names]"
+ }
+ 
+ 
  def Canvas click_deselect_io {} {
  	if {[llength $@keynav_iosel_i] || [llength $@keynav_iosel_o]} {
***************
*** 4489,4492 ****
--- 4529,4533 ----
  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]} {puts "there is a callback...."}
  	if {[$self focus] != ""} {
  		[$self focus] key $key $shift