[PD-cvs] pd/src desire.tk,1.1.2.314,1.1.2.315
Mathieu Bouchard
matju at users.sourceforge.net
Fri Aug 11 09:57:49 CEST 2006
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 ""}} {
More information about the Pd-cvs
mailing list