[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