pd/src desire.tk,1.1.2.159,1.1.2.160 - Pd-cvs

16 Apr 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25345
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
objectivised Listener
also more renamings, notably @class -> @pdclass
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.159
retrieving revision 1.1.2.160
diff -C2 -d -r1.1.2.159 -r1.1.2.160
*** desire.tk	16 Apr 2006 06:42:36 -0000	1.1.2.159
--- desire.tk	16 Apr 2006 07:13:29 -0000	1.1.2.160
***************
*** 1004,1009 ****
      wm geometry $name $geometry
      # turn buttonbar on/off
!     if {$look(buttonbar)} {pack [[button_bar_new $self] widget] -side top -fill x -expand no}
!     set @statusbar [statusbar_new $self]
      # turn statusbar on/off
      if {$look(statusbar)} {pack [$@statusbar widget] -side bottom -fill x}
--- 1004,1009 ----
      wm geometry $name $geometry
      # turn buttonbar on/off
!     if {$look(buttonbar)} {pack [[ButtonBar new $self] widget] -side top -fill x -expand no}
!     set @statusbar [StatusBar new $self]
      # turn statusbar on/off
      if {$look(statusbar)} {pack [$@statusbar widget] -side bottom -fill x}
***************
*** 1378,1382 ****
    set @noutlets 0
    #set @canvas "deadbeef"
! 	set @class ""
    #set @text $args
    set @edit 0
--- 1378,1382 ----
    set @noutlets 0
    #set @canvas "deadbeef"
! 	set @pdclass ""
    #set @text $args
    set @edit 0
***************
*** 1673,1677 ****
    if {[regexp {^x([a-f0-9]{6,8})} $tags id]} {
        global _
! 	    if {[info exists _($id:class)]} {set class $_($id:class)} {set class unknown}
        #post "(.....) $id is a [$class] object"
        return [list "object" $id]
--- 1673,1677 ----
    if {[regexp {^x([a-f0-9]{6,8})} $tags id]} {
        global _
! 	    if {[info exists _($id:pdclass)]} {set class $_($id:pdclass)} {set class unknown}
        #post "(.....) $id is a [$class] object"
        return [list "object" $id]
***************
*** 1691,1699 ****
#-----------------------------------------------------------------------------------#
! class_new statusbar {view}
! def statusbar widget {} {return .$@canvas.stat}
! def statusbar addw {row a b text args} {
    set f [$self widget]
    if {$text!=""} {eval [concat [list pack [label $f.$row.${a}_l -text $text] -side left] $args]}
--- 1691,1699 ----
#-----------------------------------------------------------------------------------#
! class_new StatusBar {view}
! def StatusBar widget {} {return .$@canvas.stat}
! def StatusBar addw {row a b text args} {
    set f [$self widget]
    if {$text!=""} {eval [concat [list pack [label $f.$row.${a}_l -text $text] -side left] $args]}
***************
*** 1702,1706 ****
  }
! def statusbar init {canvas} {
    set @canvas $canvas
    set f [$self widget]
--- 1702,1706 ----
  }
! def StatusBar init {canvas} {
    set @canvas $canvas
    set f [$self widget]
***************
*** 1722,1726 ****
  def Canvas wire_to   {} {return $@wire_to}
! def statusbar draw {x y} {
      set c .$@canvas.c
      set f [$self widget]
--- 1722,1726 ----
  def Canvas wire_to   {} {return $@wire_to}
! def StatusBar draw {x y} {
      set c .$@canvas.c
      set f [$self widget]
***************
*** 1732,1736 ****
      switch $type {
        object {
! 	if {[info exists _($id:class)]} {set class $_($id:class)} {set class unknown}
    set t "$id [$class] ($tags)"
        }
--- 1732,1736 ----
      switch $type {
        object {
! 	if {[info exists _($id:pdclass)]} {set class $_($id:pdclass)} {set class unknown}
    set t "$id [$class] ($tags)"
        }
***************
*** 2254,2259 ****
############ data transfer
! # note: @class is the server-side class name
! #  and @_class is the client-side class name
# abstract classes
--- 2254,2259 ----
############ data transfer
! # note: @pdclass is the server-side class name
! #  and   @_class is the client-side class name
# abstract classes
***************
*** 2278,2282 ****
! #             @class   {@_class}
  set classinfo(obj)     {objectbox}
  set classinfo(msg)     {messagebox}
--- 2278,2282 ----
! #             @pdclass {@_class}
  set classinfo(obj)     {objectbox}
  set classinfo(msg)     {messagebox}
***************
*** 2605,2609 ****
  class_new radio {bluebox}
  def radio orient {} {
! 	switch $@class {
    	hradio {set orient 0} hdl {set orient 0}
    	vradio {set orient 1} vdl {set orient 1}
--- 2605,2609 ----
  class_new radio {bluebox}
  def radio orient {} {
! 	switch $@pdclass {
    	hradio {set orient 0} hdl {set orient 0}
    	vradio {set orient 1} vdl {set orient 1}
***************
*** 2659,2663 ****
  class_new slider {bluebox}
  def slider orient {} {
! 	switch $@class {
    	vsl {set orient 1} default {set orient 0}
    }
--- 2659,2663 ----
  class_new slider {bluebox}
  def slider orient {} {
! 	switch $@pdclass {
    	vsl {set orient 1} default {set orient 0}
    }
***************
*** 3022,3089 ****
  ############ evaluator
! class_new listener {mumble}
! def listener new {name command} {
    set @hist {}
    set @histi 0
    set @command $command
    set @expanded 0
! 	frame $self
! 	pack [frame  $self.1]   -side left -fill y
! 	pack [frame  $self.1.1] -side bottom
! 	pack [button $self.1.1.expander -image icon_plus -command "listener_toggle_expand $self"] -side left
! 	pack [label  $self.1.1.label -text "$name: "] -side left
! 	pack [entry $self.entry -width 40] -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> "listener_eval $self"
  }
! def listener toggle_expand {} {
    set @expanded [expr 1-$@expanded]
! 	if {$@expanded} {listener_expand $self} {listener_unexpand $self}
  }
! def listener expand {} {
! 	set text [$self.entry get]
! 	destroy $self.entry
! 	pack [text $self.entry -width 40 -height 8] -side left -fill x -expand yes
! 	$self.entry insert 0.0 $text
! 	$self.1.1.expander configure -image icon_minus
! 	bind $self.entry <Alt-Return> "listener_eval $self"
  }
! def listener unexpand {} {
! 	set text [$self.entry get 0.0 end]
    regsub "\n$" $text "" text
! 	destroy $self.entry
! 	pack [entry $self.entry -width 40] -side left -fill x -expand yes
! 	$self.entry insert 0 $text
! 	$self.1.1.expander configure -image icon_plus
! 	bind $self.entry <Up>     "listener_up   $self"
! 	bind $self.entry <Down>   "listener_down $self"
! 	bind $self.entry <Return> "listener_eval $self"
  }
! def listener replace {} {
! 	$self.entry delete 0 end
! 	$self.entry insert 0 [lindex $@hist $@histi]
! 	$self.entry icursor end
  }
! def listener up   {} {if {$@histi>0} {set @histi [expr $@histi-1]; listener_replace $self}}
! def listener down {} {if {$@histi<[llength $@hist]}  {incr @histi; listener_replace $self}}
! def listener append {v} {lappend @hist $v; set @histi [llength $@hist]}
! def listener eval {} {
! 	set e $self.entry
    if {$@expanded} {
    	set l [$e get 0.0 end]
! 		listener_append $self $l
    	$e delete 0.0 end
    } {
    	set l [$e get]
! 		listener_append $self $l
    	$e delete 0 end
    }
--- 3022,3092 ----
  ############ evaluator
! class_new Listener {}
! def Listener init {serf name command} {
    set @hist {}
    set @histi 0
    set @command $command
    set @expanded 0
! 	set @serf $serf
! 	frame $serf
! 	pack [frame  $serf.1]   -side left -fill y
! 	pack [frame  $serf.1.1] -side bottom
! 	pack [button $serf.1.1.expander -image icon_plus -command "$self toggle_expand"] -side left
! 	pack [label  $serf.1.1.label -text "$name: "] -side left
! 	pack [entry $serf.entry -width 40] -side left -fill x -expand yes
! 	pack $serf -fill x -expand no
! 	bind $serf.entry <Up>     "$self up"
! 	bind $serf.entry <Down>   "$self down"
! 	bind $serf.entry <Return> "$self eval"
  }
! def Listener toggle_expand {} {
    set @expanded [expr 1-$@expanded]
! 	if {$@expanded} {$self expand} {$self unexpand}
  }
! def Listener expand {} {
! 	set e $@serf.entry
! 	set text [$e get]
! 	destroy $e
! 	pack [text $e -width 40 -height 8] -side left -fill x -expand yes
! 	$e insert 0.0 $text
! 	$@serf.1.1.expander configure -image icon_minus
! 	bind $e <Alt-Return> "$self eval"
  }
! def Listener unexpand {} {
! 	set e $@serf.entry
! 	set text [$e get 0.0 end]
    regsub "\n$" $text "" text
! 	destroy $e
! 	pack [entry $e -width 40] -side left -fill x -expand yes
! 	$e insert 0 $text
! 	$@serf.1.1.expander configure -image icon_plus
! 	bind $e <Up>     "$self up"
! 	bind $e <Down>   "$self down"
! 	bind $e <Return> "$self eval"
  }
! def Listener replace {} {
! 	$@serf.entry delete 0 end
! 	$@serf.entry insert 0 [lindex $@hist $@histi]
! 	$@serf.entry icursor end
  }
! def Listener up   {} {if {$@histi>0} {set @histi [expr $@histi-1]; $self replace}}
! def Listener down {} {if {$@histi<[llength $@hist]}  {incr @histi; $self replace}}
! def Listener append {v} {lappend @hist $v; set @histi [llength $@hist]}
! def Listener eval {} {
! 	set e $@serf.entry
    if {$@expanded} {
    	set l [$e get 0.0 end]
! 		$self append $l
    	$e delete 0.0 end
    } {
    	set l [$e get]
! 		$self append $l
    	$e delete 0 end
    }
***************
*** 3096,3102 ****
after 0 {
! 	listener_new .tcl "Tcl" {tcl_eval}
! 	listener_new .pd  "Pd"   {pd_eval}
! 	if {$cmdline(gdb) && $cmdline(gdbconsole)} {listener_new .gdb  "Gdb" {gdb_eval}}
  }
--- 3099,3105 ----
after 0 {
! 	Listener new .tcl "Tcl" {tcl_eval}
! 	Listener new .pd  "Pd"   {pd_eval}
! 	if {$cmdline(gdb) && $cmdline(gdbconsole)} {Listener new .gdb  "Gdb" {gdb_eval}}
  }
***************
*** 3146,3152 ****
set buttons_loaded 0
! class_new button_bar {Thing}
! def button_bar init {canvas} {
    global buttons_loaded butt
    set @canvas $canvas
--- 3149,3155 ----
set buttons_loaded 0
! class_new ButtonBar {Thing}
! def ButtonBar init {canvas} {
    global buttons_loaded butt
    set @canvas $canvas
***************
*** 3163,3167 ****
  }
! def button_bar widget {} {return .$@canvas.bbar}
proc obj_create {c flag} {
--- 3166,3170 ----
  }
! def ButtonBar widget {} {return .$@canvas.bbar}
proc obj_create {c flag} {