[PD-cvs] pd/src desire.tk,1.1.2.566,1.1.2.567

Mathieu Bouchard matju at users.sourceforge.net
Sun Nov 19 06:41:16 CET 2006


Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4551

Modified Files:
      Tag: devel_0_39
	desire.tk 
Log Message:
new code for automatic gdb backtrace handling


Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.566
retrieving revision 1.1.2.567
diff -C2 -d -r1.1.2.566 -r1.1.2.567
*** desire.tk	19 Nov 2006 03:17:31 -0000	1.1.2.566
--- desire.tk	19 Nov 2006 05:41:12 -0000	1.1.2.567
***************
*** 476,482 ****
       -console   set number of scrollback lines in console (0 = disable)
           -gdb   run pd server through gdb
!        -nogdb   ... or don't
!   -gdbconsole   show gdb output in console
! -nogdbconsole   ... or don't
      -valgrind   run pd server through valgrind
    -novalgrind   ... or don't"
--- 476,480 ----
       -console   set number of scrollback lines in console (0 = disable)
           -gdb   run pd server through gdb
!    -manualgdb   run gdb in the terminal
      -valgrind   run pd server through valgrind
    -novalgrind   ... or don't"
***************
*** 491,498 ****
      ^-lang\$    {incr i; set cmdline(lang)    [lindex $argv $i]}
      ^-console\$ {incr i; set cmdline(console) [lindex $argv $i]}
!       ^-gdb\$ {set cmdline(gdb) 1}
!     ^-nogdb\$ {set cmdline(gdb) 0}
!       ^-gdbconsole\$ {set cmdline(gdbconsole) 1}
!     ^-nogdbconsole\$ {set cmdline(gdbconsole) 0}
        ^-valgrind\$ {set cmdline(valgrind) 1}
      ^-novalgrind\$ {set cmdline(valgrind) 0}
--- 489,494 ----
      ^-lang\$    {incr i; set cmdline(lang)    [lindex $argv $i]}
      ^-console\$ {incr i; set cmdline(console) [lindex $argv $i]}
!            ^-gdb\$ {set cmdline(gdb) 1}
!      ^-manualgdb\$ {set cmdline(gdbconsole) 0}
        ^-valgrind\$ {set cmdline(valgrind) 1}
      ^-novalgrind\$ {set cmdline(valgrind) 0}
***************
*** 667,672 ****
  		set cmd [gets $sock]
  		if {[eof $sock]} {
! 			global errorCode
! 			tk_messageBox -message "connection ended by server. (crash?)" -type ok
  			set sock {}
  			return
--- 663,667 ----
  		set cmd [gets $sock]
  		if {[eof $sock]} {
! 			#tk_messageBox -message "connection ended by server. (crash?)" -type ok
  			set sock {}
  			return
***************
*** 694,698 ****
  		poll_sock
  		global files_to_open
- 		post "files_to_open='$files_to_open'"
  		pd pd init
  		foreach f $files_to_open {
--- 689,692 ----
***************
*** 701,705 ****
  			set file [lindex $ff [expr $ffl-1]]
  			set dir [join [lrange $ff 0 [expr $ffl-2]] [file separator]]
- 			post "f='$f' ff='$ff' ffl='$ffl'"
  			pd pd open $file $dir
  		}
--- 695,698 ----
***************
*** 714,718 ****
  		set line [gets $gdb]
  		if {$line=="" || [fblocked $gdb]} {break} ;# which way should i check for no input?
! 		if {[eof $gdb]} {tk_messageBox -message "eurggggh." -type ok; exit 69}
  		post "\[gdb\] %s" $line
  	}
--- 707,726 ----
  		set line [gets $gdb]
  		if {$line=="" || [fblocked $gdb]} {break} ;# which way should i check for no input?
! 		if {[eof $gdb]} {return}
! 		regsub {^\(gdb\) ?} $line {} line
! 		if {[regexp {^\[Thread debug} $line]} {continue}
! 		if {[regexp {^\[New Thread} $line]} {continue}
! 		if {[regexp {^Reading symbols from} $line]} {continue}
! 		if {[regexp {^Using host libthread_db} $line]} {continue}
! 		if {[regexp {^Starting program:} $line]} {continue}
! 		if {[regexp {^Program received signal (\w+), (.*)\.} $line bogus sig1 sig2]} {
! 			set where ""
! 			while {![eof $gdb]} {
! 				set line [gets $gdb]
! 				regsub {^\(gdb\) ?} $line {} line
! 				append where "$line\n"
! 			}
! 			OopsDialog new $sig1 $sig2 $where
! 		}
  		post "\[gdb\] %s" $line
  	}
***************
*** 728,735 ****
      if {$cmdline(gdb)} {
  	if {$cmdline(console) && $cmdline(gdbconsole)} {
! 	    set gdb [open "| gdb 2&>1" w+]
  	    fconfigure $gdb -blocking 0 -buffering none
  	    puts $gdb "file \"$cmdline(server)\"" ;# bad quoting, sorry
  	    puts $gdb "run -guiport $server_port"
  	    flush $gdb
  	    after 0 poll_gdb
--- 736,745 ----
      if {$cmdline(gdb)} {
  	if {$cmdline(console) && $cmdline(gdbconsole)} {
! 	    set gdb [open "| gdb --quiet 2&>1" w+]
  	    fconfigure $gdb -blocking 0 -buffering none
  	    puts $gdb "file \"$cmdline(server)\"" ;# bad quoting, sorry
  	    puts $gdb "run -guiport $server_port"
+ 	    puts $gdb "where"
+ 	    puts $gdb "quit"
  	    flush $gdb
  	    after 0 poll_gdb
***************
*** 1282,1287 ****
  def Canvas        paths {} {global main; $main paths}
  def Client          paths {} {pd pd start-path-dialog}
- def Client audio_settings {} {pd pd audio-properties}
- def Client  midi_settings {} {pd pd  midi-properties}
  def Client test_audio_and_midi {} {menu_doc_open doc/7.stuff/tools testtone.pd  }
  def Client          load_meter {} {menu_doc_open doc/7.stuff/tools load-meter.pd}
--- 1292,1295 ----
***************
*** 1307,1312 ****
      frame $w.1
      frame $w.2
!     pack [text $w.1.text -relief raised -bd 2 -font -*-courier-bold--normal--12-* \
!     	-yscrollcommand "$w.1.scroll set" -background white] -side left -fill both -expand 1
      pack [scrollbar $w.1.scroll -command "$w.1.text yview"] -side right -fill y
      pack [button $w.2.close -text [say close] -command "destroy $w"] -side right
--- 1315,1320 ----
      frame $w.1
      frame $w.2
!     pack [text $w.1.text -relief raised -bd 2 \
!     	-yscrollcommand "$w.1.scroll set"] -side left -fill both -expand 1
      pack [scrollbar $w.1.scroll -command "$w.1.text yview"] -side right -fill y
      pack [button $w.2.close -text [say close] -command "destroy $w"] -side right
***************
*** 2228,2232 ****
  	set dead [lwithout $@children $children]
  	foreach x [lreverse $dead] {$x unsubscribe $self; $x erase} ;# should use delete instead?
! 	foreach x $new {$x subscribe $self; $x changed; $x canvas= $self; puts "   $x subscribed............."}
  	set @children $children
  	foreach x $@children {$x outside_of_the_box}
--- 2236,2240 ----
  	set dead [lwithout $@children $children]
  	foreach x [lreverse $dead] {$x unsubscribe $self; $x erase} ;# should use delete instead?
! 	foreach x $new {$x subscribe $self; $x changed; $x canvas= $self}
  	set @children $children
  	foreach x $@children {$x outside_of_the_box}
***************
*** 5511,5537 ****
  	global cmdline look
  	set errMsg ""
! 	catch {
! 		if {$cmdline(console) != 0} {
! 			frame .log
! 			text .log.1 -width 60 -height 30 -yscrollcommand ".log.2 set" -font $look(View:font)
! 			scrollbar .log.2 -command ".log.1 yview"
! 			global tcl_version tk_version pd_myversion tcl_platform OS
! 			.log.1 insert end "DesireData 0.39.A"
! 			.log.1 insert end "Tcl $tcl_version, Tk $tk_version\n"
! 			foreach k [array names tcl_platform] {
! 				.log.1 insert end "tcl_platform($k) = $tcl_platform($k)\n"
! 			}
! 			pack .log.1 -side left -fill both -expand yes
! 			pack .log.2 -side left -fill    y -expand no
! 			pack .log -fill both -expand yes
! 			.log.2 set 0.0 1.0
! 			switch $OS { osx {
! 				bind .log.1 <MouseWheel> {
! 					.log.1 yview scroll [expr -2-abs(%D)/%D] units
! 				}
! 			}}
  		}
! 	} errMsg
! 	if {[string compare "" $errMsg] != 0} {puts stderr "ERROR: $errMsg"}
  }
  
--- 5519,5538 ----
  	global cmdline look
  	set errMsg ""
! 	if {$cmdline(console) == 0} {return}
! 	frame .log
! 	text .log.1 -width 80 -height 24 -yscrollcommand ".log.2 set" -font $look(View:font)
! 	scrollbar .log.2 -command ".log.1 yview"
! 	global tcl_version tk_version pd_myversion tcl_platform OS
! 	.log.1 insert end "DesireData 0.39.A, Tcl $tcl_version, Tk $tk_version\n"
! 	#foreach k [array names tcl_platform] {.log.1 insert end "tcl_platform($k) = $tcl_platform($k)\n"}
! 	pack .log.1 -side left -fill both -expand yes
! 	pack .log.2 -side left -fill    y -expand no
! 	pack .log -fill both -expand yes
! 	.log.2 set 0.0 1.0
! 	switch $OS { osx {
! 		bind .log.1 <MouseWheel> {
! 			.log.1 yview scroll [expr -2-abs(%D)/%D] units
  		}
! 	}}
  }
  
***************
*** 5642,5651 ****
  proc tcl_eval {self l} {post %s "tcl: $l"; post %s "returns: [uplevel [info level] $l]"}
  proc  pd_eval {self l} {post %s "pd: $l"; pd $l}
- proc gdb_eval {self l} {post %s "gdb: $l"; global gdb; puts $gdb "$l"}
  
  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}}
  }
  
--- 5643,5650 ----
  proc tcl_eval {self l} {post %s "tcl: $l"; post %s "returns: [uplevel [info level] $l]"}
  proc  pd_eval {self l} {post %s "pd: $l"; pd $l}
  
  after 0 {
! 	Listener new .tcl "Tcl Client" {tcl_eval}
! 	Listener new .pd  " Pd Server" { pd_eval}
  }
  
***************
*** 6804,6807 ****
--- 6803,6808 ----
  	}
  	$@nb page_select 1
+ 	# pd pd audio-properties
+ 	# pd pd  midi-properties
  }
  
***************
*** 7281,7285 ****
  
  def Canvas deconstruct {} {
! 	return [concat [list #X obj  $@x1 $@y1] $@text]
  }
  def Canvas deconstruct_to {stream args} {
--- 7282,7286 ----
  
  def Canvas deconstruct {} {
! 	return [concat [list #X restore $@x1 $@y1] $@text]
  }
  def Canvas deconstruct_to {stream args} {
***************
*** 7294,7297 ****
--- 7295,7301 ----
  }
  
+ #----------------------------------------------------------------
+ # To err is human.
+ 
  #proc bgerror {err} {
  #	global errorInfo
***************
*** 7299,7300 ****
--- 7303,7319 ----
  #	tk_messageBox -message "$err: $info" -type ok
  #}
+ 
+ class_new OopsDialog {Dialog}
+ 
+ def OopsDialog init {sig1 sig2 where} {
+ 	super damn
+ 	wm title .$self "Oops..."
+ 	pack [label .$self.head -text $sig2 -font {Helvetica -14 bold}] -side top
+ 	pack [label .$self.note -text "This program has performed a silly operation and has been shut down."] -side top
+ 	pack [text .$self.text -yscrollcommand ".$self.scroll set" -width 72 -height 15] -side left -fill both -expand 1
+ 	pack [scrollbar .$self.scroll -command ".$self.text yview"] -side right -fill y
+ 	.$self.text insert 0.0 $where
+ }
+ 
+ # Nous sommes donc en présence d'un incendie. C'est normal...
+ def OopsDialog damn {} {$self ok}





More information about the Pd-cvs mailing list