Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7570
Modified Files: Tag: devel_0_39 desire.tk Log Message: some history/undo/redo-related stuff.
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.314 retrieving revision 1.1.2.315 diff -C2 -d -r1.1.2.314 -r1.1.2.315 *** desire.tk 11 Aug 2006 04:46:45 -0000 1.1.2.314 --- desire.tk 11 Aug 2006 07:57:47 -0000 1.1.2.315 *************** *** 96,99 **** --- 96,106 ---- }
+ proc lintersection {a b} { + set r {} + foreach x $b {set c($x) {}} + foreach x $a {if {[info exists c($x)]} {lappend r $x}} + return $r + } + # removes duplicates from a list, but it must be already sorted. proc luniq {a} { *************** *** 216,230 **** # adapted from matju's MetaRuby (UndoQueue.rb)
! class_new History {Thing}
def History init {} { ! set @undo {} ! set @redo {} }
! def History can_undo? {} {return [expr [llength @undo] > 0]} ! def History can_redo? {} {return [expr [llength @redo] > 0]} def History next_undo_name {} {return stuff} def History next_redo_name {} {return stuff}
# overload this if you want to control how many levels --- 223,240 ---- # adapted from matju's MetaRuby (UndoQueue.rb)
! class_new History {Observable Thing}
def History init {} { ! super ! set @undo_q {} ! set @redo_q {} }
! def History can_undo? {} {return [expr [llength @undo_q] > 0]} ! def History can_redo? {} {return [expr [llength @redo_q] > 0]} def History next_undo_name {} {return stuff} def History next_redo_name {} {return stuff} + def History undo_q {} {return $@undo_q} + def History redo_q {} {return $@redo_q}
# overload this if you want to control how many levels *************** *** 232,237 **** # keep in mind that undo information is kept hierarchically. def History add {message} { ! lappend @undo $message ! set @redo {} }
--- 242,254 ---- # keep in mind that undo information is kept hierarchically. def History add {message} { ! lappend @undo_q [list do $message [lrange [info level -3] 1 end]] ! set @redo_q {} ! $self changed ! } ! ! def History can't {} { ! lappend @undo_q [list can't {} [lrange [info level -3] 1 end]] ! set @redo_q {} ! $self changed }
*************** *** 239,285 **** def* History undo {} { global errorInfo ! set backup $@undo ! set @undo $@redo ! set @redo {} ! set err [catch {$self perform [lindex $backup end]}] ! if {$err} {set err $errorInfo} ! set @redo $@undo ! set @undo [lrange $backup 0 end-1] ! }
def History redo {} { ! set backup $@redo ! set @redo {} ! perform [lindex $backup end] ! set @redo [lrange $backup 0 end-1] }
! # run all actions in an undo. ! #def* History perform {actions} { ! # $self atomically { ! # foreach x [lreverse $actions] {eval $actions} ! # } ! #}
! def* History perform {actions} { ! puts "perform level ---- [info level]" ! set poo $actions ! $self atomically { ! eval $actions ! } }
! def* History atomically {code} { global errorInfo ! puts "atomically level ---- [info level]" ! set ubackup @undo; set @undo {} ! set rbackup @redo; set @redo {} set err [catch {uplevel 2 $code}] - set @undo $ubackup - set @redo $rbackup - puts "err ----> $err" if {$err} {set err $errorInfo} ! if {$err} {error "error during undo"} }
--- 256,316 ---- def* History undo {} { global errorInfo ! if {![$self can_perform? [lindex $@undo_q end]]} {error "Can't undo this!"} ! set backup $@undo_q ! set @undo_q $@redo_q ! set @redo_q {} ! #set err [catch {$self perform [lindex $backup end]}]; if {$err} {set err $errorInfo} ! $self perform [lindex $backup end] ! set @redo_q $@undo_q ! set @undo_q [lrange $backup 0 end-1] ! $self changed ! #if {$err} {post %s $err; error "undo: $err"} }
def History redo {} { ! global errorInfo ! if {![$self can_perform? [lindex $@undo_q end]]} {error "Can't redo this!"} ! set backup $@redo_q ! set @redo_q {} ! set err [catch {$self perform [lindex $backup end]}]; if {$err} {set err $errorInfo} ! $self perform [lindex $backup end] ! set @redo_q [lrange $backup 0 end-1] ! $self changed ! #if {$err} {post %s $err; error "redo: $err"} }
! def History can_perform? {action} { ! switch -- [lindex $action 0] { ! do {return 1} ! can't {return 0} ! default { ! foreach x [lrange $action 1 end] { ! if {![$self can_perform? $x]} {return 0} ! } ! return 1 ! } ! } ! }
! def* History perform {action} { ! switch -- [lindex $action 0] { ! do {eval [lindex $action 1]} ! can't {error "can't undo this!"} ! default {foreach x [lindex $action 1] {$self perform $x}} ! } }
! def* History atomically {what code} { global errorInfo ! set ubackup @undo_q; set @undo_q {} ! set rbackup @redo_q; set @redo_q {} set err [catch {uplevel 2 $code}] if {$err} {set err $errorInfo} ! set atom $undo_q ! set @undo_q $ubackup ! set @redo_q $rbackup ! lappend @undo_q [list $what $atom [lrange [info level -3] 1 end]] ! $self changed ! if {$err} {puts %s $err; error "atomically: $err"} }
*************** *** 953,956 **** --- 984,993 ---- def View noutlets= {v} {set @noutlets $v} def View noutlets {} {return $@noutlets} + def* View click {args} {} ;# being clicked in run mode + def* View clickedit {args} {} ;# being clicked in edit mode + def* View unclick {args} {} ;# being unclicked in run mode + def* View unclickedit {args} {} ;# being unclicked in edit mode + def View motionedit {args} {} ;# motion in edit mode + def View motion {args} {} ;# motion in run mode
def View init {} { *************** *** 1129,1136 **** -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}
--- 1166,1176 ---- -command {pd pd midi-setapi $pd_whichmidiapi} } ! $self populate_menu .mbar.help { ! about class_browser client_class_tree clipboard_view history_view do_what_i_mean ! } }
def Client clipboard_view {} {ClipboardDialog new} + def Client history_view {} { HistoryDialog new} def Client do_what_i_mean {} {wonder}
*************** *** 1732,1787 **** }
- def ObjectBox click {args} { - puts "$self is being clicked in run mode" - } - - def ObjectBox unclick {args} { - puts "$self is being unclicked in run mode" - } - - def ObjectBox unclickedit {args} { - puts "$self is being unclicked in edit mode $args" - } - - def ObjectBox motionedit {args} { - #puts "motions in $self in edit mode" - } - - #def ObjectBox motion {args} { - # puts "motions in $self in edit mode" - #} - #-----------------------------------------------------------------------------------# def Canvas window_title {title} {wm title .$self $title} - #def Canvas add {i obj} {lset @children $i $obj} - #def Canvas del {i} {lset @children $i ""}
def Canvas children {} {return $@children}
def Canvas children= {children} { ! # think of the children!!! ! set born [lwithout $children $@children] ! ! foreach x $born { ! if {[info exists _($x:_class)]} { ! $x subscribe $self; $x changed; $x canvas= $self ! } else { ! puts "$x not born yet" ! set @unborn [lappend @unborn $x]} ! } set dead [lwithout $@children $children] ! foreach x $dead {$x unsubscribe $self; $x erase} set @children $children $self changed }
! def Canvas add {obj} { ! set i [lsearch $@children $obj] ! if {!$i} {lappend @children $obj} $obj subscribe $self; $x changed $obj canvas= $self }
! def Canvas del {obj} { set i [lsearch $@children $obj] if {$i} {set @children [lreplace $@children $i $i]} --- 1772,1810 ---- }
#-----------------------------------------------------------------------------------# def Canvas window_title {title} {wm title .$self $title}
def Canvas children {} {return $@children}
+ # think of the children!!! def Canvas children= {children} { ! set new [lwithout $children $@children] set dead [lwithout $@children $children] ! foreach x [lreverse $dead] { ! $x unsubscribe $self ! #$@history can't ;# need a way to instantiate objects with a specific index. ! $@history add [list $self insert [lsearch $@children $x] [$x deconstruct]] ! $x erase ! } ! foreach x $new { ! if {[info exists _($x:_class)]} { ! $x subscribe $self; $x changed; $x canvas= $self ! $@history add [list $self del [lsearch $children $x]] ! } else { ! lappend @unborn $x ! } ! } set @children $children $self changed }
! def Canvas add {i constructor} { ! set x [meuh] $obj subscribe $self; $x changed $obj canvas= $self + $@history add [list $self del $i] }
! def Canvas del {i} { set i [lsearch $@children $obj] if {$i} {set @children [lreplace $@children $i $i]} *************** *** 2713,2717 ****
def Canvas key {x y key iso shift} { - set c .$self.c set x [$c canvasx $x] --- 2736,2739 ---- *************** *** 2732,2737 **** if {[llength $@selection_wire] > 0} { puts "delete this $self :: $@selection_wire" - #puts "wires: $@wires_pair" - foreach x $@selection_wire { set find [lsearch $@wires_pair $x] --- 2754,2757 ---- *************** *** 2755,2764 **** Right {$self selection_move +$motion 0} Tab {$self obj_jump} ! Return {if {[llength $@selection] == 1} { ! if {$_($@selection:_class) == "ObjectBox"} { ! $@selection edit ! } ! } ! } Escape {if {[llength $@selection] > 0} {$self deselect_all}} default {} --- 2775,2783 ---- Right {$self selection_move +$motion 0} Tab {$self obj_jump} ! Return { ! if {[llength $@selection] == 1} { ! if {$_($@selection:_class) == "ObjectBox"} {$@selection edit} ! } ! } Escape {if {[llength $@selection] > 0} {$self deselect_all}} default {} *************** *** 3022,3026 ****
# real classes ! set fields(obj) [eval list $fields1] set fields(tgl) [eval list $fields1 w isa $fields2 on nonzero] set fields(bng) [eval list $fields1 w hold break isa $fields2] --- 3041,3046 ----
# real classes ! #set fields(obj) [eval list $fields1] ! #set fields(msg) {foo bar x1 y1} set fields(tgl) [eval list $fields1 w isa $fields2 on nonzero] set fields(bng) [eval list $fields1 w hold break isa $fields2] *************** *** 3035,3039 **** set fields(hdl) $fields(hradio) set fields(vdl) $fields(hradio) - set fields(msg) {foo bar x1 y1} set fields(coords) {foo bar xfrom yfrom xto yto w h gop x1 y1} set fields(floatatom) {foo bar x1 y1 w min max pos lab snd rcv} --- 3055,3058 ---- *************** *** 5139,5146 **** def Dialog ok {} {$self apply; $self cancel} def Dialog cancel {} {$self _delete} def Dialog apply {} {} def* Dialog _delete {} {destroy .$self}
! def* Dialog init {} { super set f .$self --- 5158,5166 ---- def Dialog ok {} {$self apply; $self cancel} def Dialog cancel {} {$self _delete} + def Dialog close {} {$self _delete} def Dialog apply {} {} def* Dialog _delete {} {destroy .$self}
! def* Dialog init {args} { super set f .$self *************** *** 5149,5157 **** frame $f.buttonsep -height 2 -borderwidth 1 -relief sunken frame $f.buttonframe ! foreach {a} {default cancel apply ok} { ! button $f.buttonframe.$a -text [say $a] -command "$self $a" ! pack $f.buttonframe.$a -side left -expand 1 } ! pack $f.buttonframe -side bottom -fill x -pady 2m pack $f.buttonsep -side bottom -fill x wm protocol $f WM_DELETE_WINDOW "$self cancel" --- 5169,5181 ---- frame $f.buttonsep -height 2 -borderwidth 1 -relief sunken frame $f.buttonframe ! set i 0 ! foreach a $args { ! if {[llength $args]<=1 || $i>0} { ! pack [label $f.buttonframe.$i -width 1] -side left -fill x -expand 1 ! } ! pack [button $f.buttonframe.$a -text [say $a] -command "$self $a"] -side left ! incr i } ! pack $f.buttonframe -side bottom -fill x -expand 1 -pady 2m pack $f.buttonsep -side bottom -fill x wm protocol $f WM_DELETE_WINDOW "$self cancel" *************** *** 5199,5204 **** class_new PagedDialog {Dialog}
! def PagedDialog init {} { ! super set f .$self.1 frame $f --- 5223,5228 ---- class_new PagedDialog {Dialog}
! def PagedDialog init {args} { ! eval [concat [list super] $args] set f .$self.1 frame $f *************** *** 5432,5436 **** # puts "THE END" } ! def* ServerPrefsDialog default {} { } def* ServerPrefsDialog init {} { --- 5456,5460 ---- # puts "THE END" } ! def* ServerPrefsDialog reset {} { } def* ServerPrefsDialog init {} { *************** *** 5438,5442 **** $self init_reverse_hash $self read ! super set f .$self.1 set section 0 --- 5462,5466 ---- $self init_reverse_hash $self read ! super reset cancel apply ok set f .$self.1 set section 0 *************** *** 5612,5621 **** close $fd } ! def* ClientPrefsDialog default {} { } def ClientPrefsDialog init {} { global ddrc_options look key $self read ! super set f .$self.1 set section 0 --- 5636,5645 ---- close $fd } ! def* ClientPrefsDialog reset {} { } def ClientPrefsDialog init {} { global ddrc_options look key $self read ! super reset cancel apply ok set f .$self.1 set section 0 *************** *** 5702,5706 ****
def ClientClassTreeDialog init {} { ! super pack [frame .$self.1 -width 600 -height 400] -fill y -expand y pack [frame .$self.1.1 -width 600 -height 400 -bg "#6688aa"] -side left -fill y -expand y --- 5726,5730 ----
def ClientClassTreeDialog init {} { ! super close pack [frame .$self.1 -width 600 -height 400] -fill y -expand y pack [frame .$self.1.1 -width 600 -height 400 -bg "#6688aa"] -side left -fill y -expand y *************** *** 5748,5752 ****
def AboutDialog init {} { ! super wm title .$self "About DesireData" pack [label .$self.title -text "DesireData 0.39.A.0" -font {helvetica 24}] -side top --- 5772,5776 ----
def AboutDialog init {} { ! super close wm title .$self "About DesireData" pack [label .$self.title -text "DesireData 0.39.A.0" -font {helvetica 24}] -side top *************** *** 5816,5823 **** # Thing post_hierarchy
class_new ClipboardDialog {Dialog}
def ClipboardDialog init {clipboard} { ! super set @clipboard $clipboard wm title .$self "Clipboard" --- 5840,5848 ---- # Thing post_hierarchy
+ #---------------------------------------------------------------- class_new ClipboardDialog {Dialog}
def ClipboardDialog init {clipboard} { ! super close set @clipboard $clipboard wm title .$self "Clipboard" *************** *** 5839,5843 **** }
! ClipboardDialog new $clipboard
def Wire deconstruct {{selcanvas ""}} { --- 5864,5903 ---- }
! # ClipboardDialog new $clipboard ! ! #---------------------------------------------------------------- ! class_new HistoryDialog {Dialog} ! ! def HistoryDialog init {history} { ! super close ! set @history $history ! wm title .$self "History" ! pack [listbox .$self.list -yscrollcommand ".$self.scroll set" -width 72 ! ] -side left -fill both -expand yes ! pack [scrollbar .$self.scroll -command ".$self.text yview"] -side right -fill y ! $@history subscribe $self ! $self notice ! } ! ! def HistoryDialog notice {args} { ! .$self.list delete 0 end ! set hist [concat [$@history undo_q] [list "You Are Here"] [lreverse [$@history redo_q]]] ! set k [llength [$@history undo_q]] ! set i 0 ! foreach e $hist { ! .$self.list insert end "$i: $e" ! incr i ! } ! } ! ! def HistoryDialog _delete {} { ! super ! $@clipboard unsubscribe $self ! } ! ! HistoryDialog new $history ! ! #---------------------------------------------------------------- ! # Deconstructors
def Wire deconstruct {{selcanvas ""}} {