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 .$(a)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 .$(a)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"
+ }
