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