Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14376
Modified Files: Tag: desiredata desire.tk kb-mode.tcl Log Message: more on keyboard control (key binding overwrite, key controlled selrect)
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.600.2.187 retrieving revision 1.1.2.600.2.188 diff -C2 -d -r1.1.2.600.2.187 -r1.1.2.600.2.188 *** desire.tk 31 May 2007 12:23:27 -0000 1.1.2.600.2.187 --- desire.tk 6 Jun 2007 10:44:47 -0000 1.1.2.600.2.188 *************** *** 550,553 **** --- 550,554 ---- proc read_ddrc {{filename ""}} { global cmdline look key accels + set ::accels {} if {$filename == ""} { set fd [open $cmdline(ddrcfilename) "RDONLY CREAT"] *************** *** 578,582 **** read_ddrc [file join [file dirname [file dirname $argh0]] "lib/pd/bin/defaults.ddrc"] } ! read_ddrc #-----------------------------------------------------------------------------------#
--- 579,583 ---- read_ddrc [file join [file dirname [file dirname $argh0]] "lib/pd/bin/defaults.ddrc"] } ! #read_ddrc #-----------------------------------------------------------------------------------#
*************** *** 984,989 **** #only works with tcltk 8.5 catch {tk_getOpenFile -load-once} ! set ::tk::dialog::file::showHiddenBtn 1 ! set ::tk::dialog::file::showHiddenVar 0
def Client open_file {} { --- 985,992 ---- #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 {} { *************** *** 1040,1046 ****
def Client init_menus {} { $self populate_menu file { new_file open_file {} ! server_prefs client_prefs send_message paths {} audio_on audio_off {} quit} --- 1043,1050 ----
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 {} quit} *************** *** 1564,1567 **** --- 1568,1572 ---- set @iohilite {-1 0 0 0 0} set @pointer_sense 50 + set @keyprefix 0 }
*************** *** 1677,1681 **** if {[$self look menubar]} {toplevel $win -menu $win.m} else {toplevel $win} } ! wm iconphoto $win icon_pd set butts [[ButtonBar new $self] widget] # turn buttonbar on/off --- 1682,1686 ---- if {[$self look menubar]} {toplevel $win -menu $win.m} else {toplevel $win} } ! catch {wm iconphoto $win icon_pd} set butts [[ButtonBar new $self] widget] # turn buttonbar on/off *************** *** 1721,1725 **** $c configure -yscrollcommand "$win.yscroll set" -xscrollcommand "$win.xscroll set" \ -scrollregion [list 0 0 $xregion $yregion] - puts " xregion:: $xregion || yregion:: $yregion" }
--- 1726,1729 ---- *************** *** 2070,2077 **** set m $name.m menu $m 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 paths {} close save save_as print {} quit} --- 2074,2082 ---- 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 {} quit} *************** *** 4410,4414 **** }
! def Canvas keyboard-mode {} { puts "loading keyboard-mode...." if {[file exists kb-mode.tcl]} { --- 4415,4419 ---- }
! def Canvas keyboard_mode {} { puts "loading keyboard-mode...." if {[file exists kb-mode.tcl]} { *************** *** 4420,4431 **** }
! 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 {} { --- 4425,4443 ---- }
! def Canvas keyboard_mode_exit {} { puts "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 {} {
Index: kb-mode.tcl =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/kb-mode.tcl,v retrieving revision 1.1.2.3 retrieving revision 1.1.2.4 diff -C2 -d -r1.1.2.3 -r1.1.2.4 *** kb-mode.tcl 31 May 2007 12:23:29 -0000 1.1.2.3 --- kb-mode.tcl 6 Jun 2007 10:44:49 -0000 1.1.2.4 *************** *** 7,11 **** set self "kbcursor" append_callback kb-mode key kb-mode_key - append_callback kb-mode motion kb-mode_motion Kb_cursor new_as $self $canvas $self draw --- 7,10 ---- *************** *** 16,19 **** --- 15,22 ---- set c [$self widget] set step [$@kbcursor step] + if {$@keyprefix} { + $@kbcursor get_key $key + set @keyprefix 0 + } switch $key { BackSpace {$self delete_selection} *************** *** 28,32 **** }
! def Canvas kb-mode_motion {x y f target} {}
class_new Kb_cursor {View} --- 31,43 ---- }
! def Canvas kbcursor_move_up {} {$@kbcursor move 0 -[$@kbcursor step]} ! def Canvas kbcursor_move_down {} {$@kbcursor move 0 [$@kbcursor step]} ! def Canvas kbcursor_move_left {} {$@kbcursor move -[$@kbcursor step] 0} ! def Canvas kbcursor_move_right {} {$@kbcursor move [$@kbcursor step] 0} ! ! def Canvas move_selection_up {} {$self arrow_key 0 -[$@kbcursor step]} ! def Canvas move_selection_down {} {$self arrow_key 0 +[$@kbcursor step]} ! def Canvas move_selection_left {} {$self arrow_key -[$@kbcursor step] 0} ! def Canvas move_selection_right {} {$self arrow_key 0 +[$@kbcursor step] 0}
class_new Kb_cursor {View} *************** *** 39,45 **** set @h [expr [font metrics [$self look font] -linespace]+3] set @step [expr ceil($@h*1.5)] }
! def Kb_cursor xy {} {return [list [expr $@x+4] $@y]} def Kb_cursor step {} {return $@step}
--- 50,60 ---- set @h [expr [font metrics [$self look font] -linespace]+3] set @step [expr ceil($@h*1.5)] + set @prefixkeys {} + $self init_keys + $self recenter }
! ! def Kb_cursor xy {} {return [list $@x $@y]} def Kb_cursor step {} {return $@step}
*************** *** 61,64 **** --- 76,86 ---- $self test_bounds $self draw + set action [$@canvas action] + if {$action != "none"} { + if {[$action class] == "SelRect"} { + $action motion $@x $@y 256 "none" + } + + } }
*************** *** 112,123 **** }
! def Canvas kbcursor_Object {} {mset {x y} [$@kbcursor xy]; $self new_objectxy $x $y obj} ! def Canvas kbcursor_Message {} {mset {x y} [$@kbcursor xy]; $self new_objectxy $x $y msg} ! def Canvas kbcursor_bng {} {mset {x y} [$@kbcursor xy]; $self new_objectxy $x $y obj bng} ! def Canvas kbcursor_tgl {} {mset {x y} [$@kbcursor xy]; $self new_objectxy $x $y obj tgl} ! def Canvas kbcursor_nbx {} {mset {x y} [$@kbcursor xy]; $self new_objectxy $x $y obj nbx}
def Canvas kbcursor_select {} { ! mset {x y} [lmap + [$@kbcursor xy] 4] mset {type id detail} [$self identify_target $x $y 0] puts "type:: $type || id:: $id || detail:: $detail" --- 134,145 ---- }
! def Canvas kbcursor_Object {} {mset {x y} [$@kbcursor xy]; $self new_objectxy [expr $x+4] $y obj} ! def Canvas kbcursor_Message {} {mset {x y} [$@kbcursor xy]; $self new_objectxy [expr $x+4] $y msg} ! def Canvas kbcursor_bng {} {mset {x y} [$@kbcursor xy]; $self new_objectxy [expr $x+4] $y obj bng} ! def Canvas kbcursor_tgl {} {mset {x y} [$@kbcursor xy]; $self new_objectxy [expr $x+4] $y obj tgl} ! def Canvas kbcursor_nbx {} {mset {x y} [$@kbcursor xy]; $self new_objectxy [expr $x+4] $y obj nbx}
def Canvas kbcursor_select {} { ! mset {x y} [lmap + [$@kbcursor xy] 4]; set x [expr $x+4] mset {type id detail} [$self identify_target $x $y 0] puts "type:: $type || id:: $id || detail:: $detail" *************** *** 125,127 **** --- 147,210 ---- if {![$id selected?]} {$self selection+= $id} else {$self selection-= $id} } + } + + def Kb_cursor init_keys {} { + global newkey accels + #@keys used for prefix keycommands + dict set @prefixkeys "1" "kbcursor_Object" + dict set @prefixkeys "2" "kbcursor_Message" + dict set @prefixkeys "b" "kbcursor_bng" + dict set @prefixkeys "t" "kbcursor_tgl" + dict set @prefixkeys "3" "kbcursor_nbx" + #@ctrlkeys overwrites the existing keybindings + foreach {key command} $newkey { + if {[catch {set vars [dict get $accels $key]}]} {puts "$key not bound yet......";set vars {}} + set new_val {} + foreach item $vars { + mset {class cmd} [split $item ":"] + if {$class == [$@canvas class]} { + set n $class:$command + lappend new_val $n + } else { + lappend new_val $item + } + } + if {$new_val == ""} {set new_val [$@canvas class]:$command} + dict set accels $key $new_val + } + + } + + def Kb_cursor get_key {key} { + if {[catch {set command [dict get $@prefixkeys $key]}]} { + post "key Ctrl-x $key not bound" + } { + puts "run $command" + $@canvas $command + } + } + + set newkey { + Ctrl+p {kbcursor_move_up} + Ctrl+n {kbcursor_move_down} + Ctrl+f {kbcursor_move_right} + Ctrl+b {kbcursor_move_left} + Ctrl+P {move_selection_up} + Ctrl+N {move_selection_down} + Ctrl+F {move_selection_right} + Ctrl+B {move_selection_left} + Alt+f {} + Alt+b {} + Ctrl+space {kbcursor_mark} + } + + def Canvas kbcursor_mark {} { + mset {x y} [$@kbcursor xy] + if {$@action == "none"} { + set @action [SelRect new $self $x $y 256 "none"] + } else { + if {[$@action class] == "SelRect"} { + $@action unclick $x $y 236 "none" + } + } } \ No newline at end of file