pd/src desire.tk,1.1.2.71,1.1.2.72 - Pd-cvs

20 Sep 2005


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6968
Modified Files:
      Tag: devel_0_39
    desire.tk 
Log Message:
added -valgrind
compacted error backtraces for commands that came thru the socket
etc.
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.71
retrieving revision 1.1.2.72
diff -C2 -d -r1.1.2.71 -r1.1.2.72
*** desire.tk	20 Sep 2005 00:43:37 -0000	1.1.2.71
--- desire.tk	20 Sep 2005 09:49:30 -0000	1.1.2.72
***************
*** 168,174 ****
  }
! proc mset {vars list} {
! 	uplevel 1 "foreach {$vars} {$list} {}"
! }
# there are two palettes of 30 colours used in Pd
--- 168,172 ----
  }
! proc mset {vars list} {uplevel 1 "foreach {$vars} {$list} {}"}
# there are two palettes of 30 colours used in Pd
***************
*** 242,245 ****
--- 240,244 ----
  set cmdline(icons) icons
  set cmdline(gdb) 1
+ set cmdline(valgrind) 0
  set files_to_open {}
***************
*** 251,254 ****
--- 250,255 ----
      ^-gdb$ {set cmdline(gdb) 1}
      ^-nogdb$ {set cmdline(gdb) 0}
+     ^-valgrind$ {set cmdline(valgrind) 1}
+     ^-novalgrind$ {set cmdline(valgrind) 0}
      ^- {puts "ERROR: command line argument: unknown $o"}
      default {lappend files_to_open [lindex $argv $i]}
***************
*** 259,264 ****
  menu .mbar
! frame .controls
! pack .controls -side top -fill x
  menu .mbar.file -tearoff $pd_tearoff; .mbar add cascade -label "File" -menu .mbar.file
  menu .mbar.find -tearoff $pd_tearoff; .mbar add cascade -label "Find" -menu .mbar.find
--- 260,264 ----
  menu .mbar
! pack [frame .controls] -side top -fill x
  menu .mbar.file -tearoff $pd_tearoff; .mbar add cascade -label "File" -menu .mbar.file
  menu .mbar.find -tearoff $pd_tearoff; .mbar add cascade -label "Find" -menu .mbar.find
***************
*** 319,328 ****
    meterbutton "meters"   ctrls_meter_on {pd "pd meters $ctrls_meter_on ;"}
  } {
! 	checkbutton .controls.switches.$w -text $x -variable $y -anchor w -command $z
! 	pack .controls.switches.$w -side left
  }
! button .controls.switches.dio -text "io errors" -command {pd "pd audiostatus ;"}
! pack .controls.switches.dio
  pack .controls.switches -side right
--- 319,328 ----
    meterbutton "meters"   ctrls_meter_on {pd "pd meters $ctrls_meter_on ;"}
  } {
! 	pack [checkbutton .controls.switches.$w -text $x \
! 		-variable $y -anchor w -command $z] -side left
  }
! pack [button .controls.switches.dio -text "io errors" \
! 	-command {pd "pd audiostatus ;"}]
  pack .controls.switches -side right
***************
*** 375,378 ****
--- 375,380 ----
    		  "^missing close-brace" {set sock_lobby $sock_lobby$cmd; continue}
    		}
+ 			regsub -all "    invoked from within\n" $errorInfo "" errorInfo
+ 			regsub -all "\n    \(" $errorInfo " (" errorInfo
    		puts "Exception: errorCode=$errorCode; errorInfo=$errorInfo"
    	}
***************
*** 418,433 ****
  set server_sock [socket -server accept_pd 13666]
! if {$cmdline(gdb)} {
    set gdb [open "| gdb" w+]
! 	fconfigure $gdb -blocking 0 -buffering line
    puts $gdb "file pd"
    puts $gdb "run -guiport 13666"
    flush $gdb
    after 0 poll_gdb
! } {
    exec pd -guiport 13666 &
  }
- 
  ################ utility functions #########################
--- 420,438 ----
  set server_sock [socket -server accept_pd 13666]
! if {$cmdline(valgrind)} {
! 	exec valgrind --tool=memcheck pd -guiport 13666 &
! } {
!     if {$cmdline(gdb)} {
    set gdb [open "| gdb" w+]
! 	fconfigure $gdb -blocking 0 -buffering none
    puts $gdb "file pd"
    puts $gdb "run -guiport 13666"
    flush $gdb
    after 0 poll_gdb
!     } {
    exec pd -guiport 13666 &
+     }
  }
################ utility functions #########################
***************
*** 504,509 ****
  proc menu_send {} {
      toplevel .sendpanel
!     entry .sendpanel.entry -textvariable send_textvariable
!     pack .sendpanel.entry -side bottom -fill both -ipadx 100
      .sendpanel.entry select from 0
      .sendpanel.entry select adjust end
--- 509,513 ----
  proc menu_send {} {
      toplevel .sendpanel
!     pack [entry .sendpanel.entry -textvariable send_textvariable] -side bottom -fill both -ipadx 100
      .sendpanel.entry select from 0
      .sendpanel.entry select adjust end
***************
*** 756,768 ****
      toplevel $name -menu $name.m
      wm geometry $name $geometry
-     canvas $name.c -width $width -height $height -background white \
-     	-yscrollcommand "$name.yscroll set" \
-     	-xscrollcommand "$name.xscroll set" \
- 	-scrollregion [list 0 0 $width $height] 
      pack [make_button_bar $name.bbar $name] -side top -fill x -expand no
      pack [statusbar_new $self] -side bottom -fill x
      pack [scrollbar $name.xscroll -command "$name.c xview" -orient horizontal] -side bottom -fill x
      pack [scrollbar $name.yscroll -command "$name.c yview"] -side  right -fill y
!     pack $name.c -side left -expand 1 -fill both
      wm minsize $name 1 1
      wm geometry $name $geometry
--- 760,771 ----
      toplevel $name -menu $name.m
      wm geometry $name $geometry
      pack [make_button_bar $name.bbar $name] -side top -fill x -expand no
      pack [statusbar_new $self] -side bottom -fill x
      pack [scrollbar $name.xscroll -command "$name.c xview" -orient horizontal] -side bottom -fill x
      pack [scrollbar $name.yscroll -command "$name.c yview"] -side  right -fill y
!     pack [canvas $name.c -width $width -height $height -background white \
!     	-yscrollcommand "$name.yscroll set" \
!     	-xscrollcommand "$name.xscroll set" \
! 	-scrollregion [list 0 0 $width $height]] -side left -expand 1 -fill both
      wm minsize $name 1 1
      wm geometry $name $geometry
***************
*** 1954,1966 ****
    	}
    	puts "_($x:_class)=$_($x:_class)"
! 		# hack
! 		set canvas $_($x:canvas)
! 		$x init
! 		set _($x:text) [lrange $d $i end]
! 		set _($x:valid) 0
! 		$x update_size
! 		$x draw $canvas
! 		if {[string length $_($x:text)]==0} {$x edit $canvas}
! 		set _($_($x:canvas):selection) $x
    }
    if {![info exists fields($class)]} {set class obj}
--- 1957,1971 ----
    	}
    	puts "_($x:_class)=$_($x:_class)"
! 		if {[info exists _($x:canvas)]} {
! 			# hack
! 			set canvas $_($x:canvas)
! 			$x init
! 			set _($x:text) [lrange $d $i end]
! 			set _($x:valid) 0
! 			$x update_size
! 			$x draw $canvas
! 			if {[string length $_($x:text)]==0} {$x edit $canvas}
! 			set _($_($x:canvas):selection) $x
! 		}
    }
    if {![info exists fields($class)]} {set class obj}
***************
*** 2676,2681 ****
  }
! 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]}
--- 2681,2686 ----
  }
! 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]}
***************
*** 2847,2858 ****
    toplevel .browser
    set f .browser.cl
! 	frame $f
! 	label .browser.title -text ""
! 	pack .browser.title -side top
    listbox $f.1 -width 30 -height 10 -yscrollcommand "$f.2 set"
    scrollbar $f.2 -command "$f.1 yview"
    text $f.3 -width 30 -height 10 -yscrollcommand "$f.4 set"
    scrollbar $f.4 -command "$f.3 yview"
- 	pack $f -side top -fill both -expand yes
frame $f.5
--- 2852,2861 ----
    toplevel .browser
    set f .browser.cl
! 	pack [frame $f] -side top -fill both -expand yes
! 	pack [label .browser.title -text ""] -side top
    listbox $f.1 -width 30 -height 10 -yscrollcommand "$f.2 set"
    scrollbar $f.2 -command "$f.1 yview"
    text $f.3 -width 30 -height 10 -yscrollcommand "$f.4 set"
    scrollbar $f.4 -command "$f.3 yview"
frame $f.5