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($(a)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($(a)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