[PD-cvs] pd/src desire.tk, 1.1.2.600.2.187, 1.1.2.600.2.188 kb-mode.tcl, 1.1.2.3, 1.1.2.4

chunlee chunlee at users.sourceforge.net
Wed Jun 6 12:44:52 CEST 2007


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





More information about the Pd-cvs mailing list