Update of /cvsroot/pure-data/pd/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1872
Modified Files: Tag: devel_0_39 desire.tk Log Message: added tclbox
Index: desire.tk =================================================================== RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v retrieving revision 1.1.2.20 retrieving revision 1.1.2.21 diff -C2 -d -r1.1.2.20 -r1.1.2.21 *** desire.tk 4 Sep 2005 06:27:27 -0000 1.1.2.20 --- desire.tk 4 Sep 2005 06:44:27 -0000 1.1.2.21 *************** *** 3719,3720 **** --- 3719,3803 ---- }
+ ##################################################################################### + ############ evaluator + + def listener new {name command} { + set _($self:hist) {} + set _($self:histi) 0 + set _($self:command) $command + frame $self + button $self.expander -image icon_plus -command "listener_expand $self" + label $self.label -text "$name: " + entry $self.entry -width 40 + pack $self.expander -side left + pack $self.label -side left + pack $self.entry -side left -fill x -expand yes + pack $self -fill x -expand no + bind $self.entry <Up> "listener_up $self" + bind $self.entry <Down> "listener_down $self" + bind $self.entry <Return> $command + } + + def listener expand {} { + set text [$self.entry get] + destroy $self.entry + text $self.entry -width 40 -height 8 + $self.entry insert 0.0 $text + pack $self.entry -side left -fill x -expand yes + $self.expander configure -image icon_minus -command "listener_unexpand $self" + #bind $self.entry <Alt-Return> $_($self:command) + } + + def listener unexpand {} { + set text [$self.entry get 0.0 end] + regsub "\n$" $text "" text + destroy $self.entry + entry $self.entry -width 40 + $self.entry insert 0 $text + pack $self.entry -side left -fill x -expand yes + $self.expander configure -image icon_plus -command "listener_expand $self" + bind $self.entry <Up> "listener_up $self" + bind $self.entry <Down> "listener_down $self" + bind $self.entry <Return> $_($self:command) + } + + def listener up {} { + if {$_($self:histi) > 0} {set _($self:histi) [expr -1+$_($self:histi)]} + $self.entry delete 0 end + $self.entry insert 0 [lindex $_($self:hist) $_($self:histi)] + $self.entry icursor end + } + + def listener down {} { + if {$_($self:histi) < [llength $_($self:hist)]} {incr _($self:histi)} + $self.entry delete 0 end + $self.entry insert 0 [lindex $_($self:hist) $_($self:histi)] + $self.entry icursor end + } + + def listener append {v} { + lappend _($self:hist) $v + set _($self:histi) [llength $_($self:hist)] + } + + proc tcl_eval {} { + set l [.tcl.entry get] + listener_append .tcl [.tcl.entry get] + .tcl.entry delete 0 end + post %s "tcl: $l\nreturns: [eval $l]" + } + + global cmdline + after 1 { + # if {$cmdline(console) != 0} { + listener_new .tcl "Tcl" {tcl_eval} + # } + } + + ##################################################################################### + + proc post {args} { + # post_to_gui [eval [linsert $args 0 format]] + # post_to_gui "\n" + puts stderr [eval [linsert $args 0 format]] + }