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}