Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21011
Modified Files: Tag: devel_0_39 desire.tk Log Message: new Copy (Ctrl+C) ! added clipboard viewer in help menu
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.310 retrieving revision 1.1.2.311 diff -C2 -d -r1.1.2.310 -r1.1.2.311 *** desire.tk 10 Aug 2006 19:51:17 -0000 1.1.2.310 --- desire.tk 11 Aug 2006 00:55:30 -0000 1.1.2.311 *************** *** 185,197 **** #-----------------------------------------------------------------------------------# # object class just to make a variable watchable...? ! # but really, we should look at "man 3tcl trace" instead.
class_new Variable {Observable Thing} ! ! def Variable init {value} {super; set @value $value; $self changed} ! def Variable value= {value} { set @value $value; $self changed} def Variable value {} {return $@value}
#-----------------------------------------------------------------------------------# # adapted from matju's MetaRuby (UndoQueue.rb)
--- 185,206 ---- #-----------------------------------------------------------------------------------# # object class just to make a variable watchable...? ! # should also have a look at "man 3tcl trace" too.
class_new Variable {Observable Thing} ! def Variable init {{value ""}} {super; $self value= $value} ! def Variable value= {value} {set @value $value; $self changed} def Variable value {} {return $@value}
#-----------------------------------------------------------------------------------# + # we might also use "man 3tk clipboard" in this specific case. + + class_new Clipboard {Observable Thing} + def Clipboard init {{value ""}} {super; $self value= $value} + def Clipboard value= {value} {clipboard clear; clipboard append $value; $self changed} + def Clipboard << {value} { clipboard append $value; $self changed} + def Clipboard value {} {clipboard get} + set clipboard [Clipboard new] + + #-----------------------------------------------------------------------------------# # adapted from matju's MetaRuby (UndoQueue.rb)
*************** *** 530,538 ****
proc pdtk_pd_startup {version apilist midiapilist fontname} { ! global pd_myversion pd_apilist pd_midiapilist set pd_myversion $version set pd_apilist $apilist set pd_midiapilist $midiapilist ! menu_addstd .mbar }
--- 539,547 ----
proc pdtk_pd_startup {version apilist midiapilist fontname} { ! global pd_myversion pd_apilist pd_midiapilist main set pd_myversion $version set pd_apilist $apilist set pd_midiapilist $midiapilist ! $main menu_addstd }
*************** *** 784,789 **** foreach name $list { if {$name == ""} {$menu add separator; continue} $menu add command -label [say $name] -command "$self $name" \ ! -accelerator [accel_munge $key($name)] } } --- 793,799 ---- foreach name $list { if {$name == ""} {$menu add separator; continue} + if {[llength [array names key $name]]} {set k $key($name)} {set k ""} $menu add command -label [say $name] -command "$self $name" \ ! -accelerator [accel_munge $k] } } *************** *** 1019,1024 **** #}
- # in the future, one View may have several canvases. (??) - # this would mean that the following proc will have to die. def View canvas {} {return $@canvas} def View canvas= {c} {set @canvas $c} --- 1029,1032 ---- *************** *** 1029,1033 ****
def Canvas close {} { ! switch [tk_messageBox -message [say savechanges?] -icon question -type yesnocancel -default cancel] { yes {$self save; pd .$self close} no { pd .$self close} --- 1037,1041 ----
def Canvas close {} { ! switch [tk_messageBox -message [say save_changes?] -icon question -type yesnocancel -default cancel] { yes {$self save; pd .$self close} no { pd .$self close} *************** *** 1085,1119 **** def Client latency_meter {} {menu_doc_open doc/7.stuff/tools latency.pd } def Client menu_documentation {} {pd menu_documentation}
! proc menu_addstd {mbar} { ! global pd_apilist pd_midiapilist main OS set m .mbar.media ! $main populate_menu $m { ! audio_on audio_off {}} switch $OS { osx {} ! default { ! $main populate_menu $m { ! audio_settings midi_settings} ! } } ! $main populate_menu $m {{} ! test_audio_and_midi load_meter latency_meter} foreach a $pd_apilist { $m add radiobutton -label [lindex $a 0] -variable pd_whichapi -value [lindex $a 1] \ -command {pd pd audio-setapi $pd_whichapi} } ! $main populate_menu $m {{}} foreach a $pd_midiapilist { $m add radiobutton -label [lindex $a 0] -variable pd_whichmidiapi -value [lindex $a 1] \ -command {pd pd midi-setapi $pd_whichmidiapi} } ! $main populate_menu .mbar.help { ! about class_browser client_class_tree} }
! def Client about {} {AboutDialog new} ! ! def Client class_browser {} {Browser new_as browser browser 0 0 ""}
proc menu_audio {flag} {pd pd dsp $flag} --- 1093,1122 ---- def Client latency_meter {} {menu_doc_open doc/7.stuff/tools latency.pd } def Client menu_documentation {} {pd menu_documentation} + def Client about {} {AboutDialog new} + def Client class_browser {} {Browser new_as browser browser 0 0 ""}
! def Client menu_addstd {} { ! global pd_apilist pd_midiapilist OS set m .mbar.media ! $self populate_menu $m {audio_on audio_off {}} switch $OS { osx {} ! default {$self populate_menu $m {audio_settings midi_settings}} } ! $self populate_menu $m {{} test_audio_and_midi load_meter latency_meter} foreach a $pd_apilist { $m add radiobutton -label [lindex $a 0] -variable pd_whichapi -value [lindex $a 1] \ -command {pd pd audio-setapi $pd_whichapi} } ! $self populate_menu $m {{}} foreach a $pd_midiapilist { $m add radiobutton -label [lindex $a 0] -variable pd_whichmidiapi -value [lindex $a 1] \ -command {pd pd midi-setapi $pd_whichmidiapi} } ! $self populate_menu .mbar.help {about class_browser client_class_tree clipboard_view do_what_i_mean} }
! def Client clipboard_view {} {ClipboardDialog new} ! def Client do_what_i_mean {} {wonder}
proc menu_audio {flag} {pd pd dsp $flag} *************** *** 1762,1775 ****
def Canvas wires= {wires2} { ! global _ canvas clipboard set wires {} # look up for wire id foreach x $wires2 { ! set outobj [lindex $x 0] ! set outport [lindex $x 1] ! set inobj [lindex $x 2] ! set inport [lindex $x 3] set obj1 [lindex $@children $outobj] ! set obj2 [lindex $@children $inobj] set find [lsearch $@wires_pair $x] if { $find == -1} { --- 1765,1775 ----
def Canvas wires= {wires2} { ! global canvas clipboard set wires {} # look up for wire id foreach x $wires2 { ! mset {outobj outport inobj inport} $x set obj1 [lindex $@children $outobj] ! set obj2 [lindex $@children $inobj] set find [lsearch $@wires_pair $x] if { $find == -1} { *************** *** 1778,1782 **** lappend @wires_pair [list $outobj $outport $inobj $inport] set new_wire [eval [list Wire_new $self $outobj $outport $inobj $inport]] ! lappend @wires_pair $new_wire lappend wires $new_wire } else {puts "$obj1 or $obj2 not been born yet....."; set @unborn_wire [lappend @unborn_wire $x]} --- 1778,1782 ---- lappend @wires_pair [list $outobj $outport $inobj $inport] set new_wire [eval [list Wire_new $self $outobj $outport $inobj $inport]] ! lappend @wires_pair $new_wire lappend wires $new_wire } else {puts "$obj1 or $obj2 not been born yet....."; set @unborn_wire [lappend @unborn_wire $x]} *************** *** 2001,2005 ****
#-----------------------------------------------------------------------------------# ! class_new StatusBar {View}
def StatusBar widget {} {return .$@canvas.stat} --- 2001,2005 ----
#-----------------------------------------------------------------------------------# ! class_new StatusBar {View} ;# no, using View is wrong here. View is for tk canvas item collections.
def StatusBar widget {} {return .$@canvas.stat} *************** *** 2124,2138 **** }
def* Canvas copy {} { ! global clipboard ! if {$@selection != ""} { ! set clipboard(orig_cpcanvas) $self ! set clipboard(objs) $@selection ! set clipboard(wires) $@selection_wire ! set clipboard(copy_times) 0 ! puts "objects to copy::: $clipboard(objs)" ! puts "wires to copy::: $clipboard(wires)" } - }
--- 2124,2152 ---- }
+ def Canvas index {child} { + # this could be O(1) if the proper database were maintained. + return [lsearch $@children $child] + } + def* Canvas copy {} { ! global clipboard obj_index_sel ! if {$@selection == ""} {return} ! #$clipboard value= [$self deconstruct] ! $clipboard value= "" ! #$clipboard canvas= $self ! #$clipboard copy_times= 0 ! #$self deconstruct_to $clipboard ! array unset obj_index_sel $self:* ! foreach child $@selection { ! #set obj_index_sel($self:$child) [$self index $child] ! set obj_index_sel($self:$child) [lsearch $@selection $child] ! $child deconstruct_to $clipboard ! } ! puts [array names obj_index_sel -glob $self:*] ! foreach wire $@selection_wire { ! if {[array names obj_index_sel $self:[$wire from]] == ""} {continue} ! if {[array names obj_index_sel $self:[$wire to ]] == ""} {continue} ! $wire deconstruct_to $clipboard $self } }
*************** *** 2898,2902 **** def Wire init {canvas from outno to inno} { super - global _ set @connects [list $from $outno $to $inno] #puts "------ children:$_($canvas:children)" --- 2912,2915 ---- *************** *** 2912,2916 **** # associate wires to its connected objects lappend _($@obj1:wires) $self ! puts "_($@obj1:wires) is $_($@obj1:wires)" lappend _($@obj2:wires) $self # select_by is a hack to get wires remain hilited if selected by serect.... --- 2925,2929 ---- # associate wires to its connected objects lappend _($@obj1:wires) $self ! puts "_($@obj1:wires) is $_($@obj1:wires)" lappend _($@obj2:wires) $self # select_by is a hack to get wires remain hilited if selected by serect.... *************** *** 2918,2921 **** --- 2931,2939 ---- }
+ def Wire from {} {return $@obj1} + def Wire outlet {} {return $@port1} + def Wire to {} {return $@obj2} + def Wire inlet {} {return $@port2} + def Wire draw {} { #set thick 2 *************** *** 3344,3349 **** class_new IEMPropertiesDialog {PropertiesDialog}
- def* IEMPropertiesDialog cancel {} {$self _delete} - def* IEMPropertiesDialog apply {} { global fields classinfo --- 3362,3365 ---- *************** *** 5183,5190 ****
class_new Dialog {Thing} ! #what's the difference between ok and apply? ! def* Dialog ok {} {$self apply; $self cancel} ! def Dialog cancel {} {} ! def Dialog apply {} {} def* Dialog _delete {} {destroy .$self}
--- 5199,5205 ----
class_new Dialog {Thing} ! def Dialog ok {} {$self apply; $self cancel} ! def Dialog cancel {} {$self _delete} ! def Dialog apply {} {} def* Dialog _delete {} {destroy .$self}
*************** *** 5410,5414 ****
class_new ServerPrefsDialog {PagedDialog} - def ServerPrefsDialog cancel {} {$self _delete} def ServerPrefsDialog apply {} {$self write}
--- 5425,5428 ---- *************** *** 5586,5590 ****
class_new ClientPrefsDialog {PagedDialog} - def ClientPrefsDialog cancel {} {$self _delete} def ClientPrefsDialog apply {} {$self write}
--- 5600,5603 ---- *************** *** 5734,5738 **** def Client client_class_tree {} {ClientClassTreeDialog new} class_new ClientClassTreeDialog {Dialog} - def ClientClassTreeDialog cancel {} {destroy .$self}
proc* place_stuff {args} {} --- 5747,5750 ---- *************** *** 5801,5805 **** wm title .$self "About DesireData" pack [label .$self.title -text "DesireData 0.39.A.0" -font {helvetica 24}] -side top ! pack [label .$self.date -text "released on 2006.07.??"] -side top pack [text .$self.text -yscrollcommand ".$self.scroll set" -width 72 ] -side left -fill both -expand yes --- 5813,5817 ---- wm title .$self "About DesireData" pack [label .$self.title -text "DesireData 0.39.A.0" -font {helvetica 24}] -side top ! pack [label .$self.date -text "released on 2006.08.??"] -side top pack [text .$self.text -yscrollcommand ".$self.scroll set" -width 72 ] -side left -fill both -expand yes *************** *** 5843,5848 **** }
- def AboutDialog cancel {} {$self _delete} - #c proc updatesel {_ sel} { #c variable "" --- 5855,5858 ---- *************** *** 5868,5869 **** --- 5878,5930 ---- # Thing post_hierarchy
+ class_new ClipboardDialog {Dialog} + + def ClipboardDialog init {} { + global clipboard + super + wm title .$self "Clipboard" + pack [text .$self.text -yscrollcommand ".$self.scroll set" -width 72 + ] -side left -fill both -expand yes + pack [scrollbar .$self.scroll -command ".$self.text yview"] -side right -fill y + $clipboard subscribe $self + $self notice + } + + def ClipboardDialog notice {args} { + global clipboard + .$self.text delete 0.0 end + .$self.text insert 0.0 [$clipboard value] + } + + def ClipboardDialog _delete {} { + super + $clipboard unsubscribe $self + } + + ClipboardDialog new + + def Wire deconstruct {{selcanvas ""}} { + global obj_index_sel + if {$selcanvas == ""} { + list #X connect \ + [$@canvas index $@obj1] $@port1 \ + [$@canvas index $@obj2] $@port2 + } { + list #X connect \ + $obj_index_sel($@canvas:$@obj1) $@port1 \ + $obj_index_sel($@canvas:$@obj2) $@port2 + } + } + + def ObjectBox deconstruct {} {concat [list #X obj $@x1 $@y1] $@text} + def MessageBox deconstruct {} {concat [list #X msg $@x1 $@y1] $@text} + def Comment deconstruct {} {concat [list #X text $@x1 $@y1] $@text} + + def* View deconstruct_to {stream args} { + $stream << [eval [concat [list $self deconstruct] $args]] + $stream << ";\n" + } + + def Canvas deconstruct {} { + error "Canvas deconstruct: that's a feature request" + }