[PD-cvs] pd/src desire.tk,1.1.2.20,1.1.2.21

[Mathieu Bouchard]

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]]
+ }