[PD-cvs] pd/src desire.tk,1.1.2.34,1.1.2.35
Mathieu Bouchard
matju at users.sourceforge.net
Tue Sep 6 13:37:54 CEST 2005
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32260
Modified Files:
Tag: devel_0_39
desire.tk
Log Message:
option -gdb (currently default) starts gdb between desire.tk and pd.
option -nogdb turns it off.
added gdbbox.
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.34
retrieving revision 1.1.2.35
diff -C2 -d -r1.1.2.34 -r1.1.2.35
*** desire.tk 6 Sep 2005 08:14:54 -0000 1.1.2.34
--- desire.tk 6 Sep 2005 11:37:52 -0000 1.1.2.35
***************
*** 158,171 ****
set cmdline(console) 1000
set cmdline(icons) icons
for {set i 0} {$i < $argc} {incr i} {
global cmdline
set o [lindex $argv $i]
! switch -- $o {
-console {
incr i
set cmdline(console) [lindex $argv $i]
}
! default {puts "ERROR: command line argument: unknown $o"}
}
}
--- 158,179 ----
set cmdline(console) 1000
set cmdline(icons) icons
+ set cmdline(gdb) 1
+ set files_to_open {}
for {set i 0} {$i < $argc} {incr i} {
global cmdline
set o [lindex $argv $i]
! switch -regexp -- $o {
-console {
incr i
set cmdline(console) [lindex $argv $i]
}
! -gdb {set cmdline(gdb) 1}
! -nogdb {set cmdline(gdb) 0}
! -* {puts "ERROR: command line argument: unknown $o"}
! default {
! incr i
! lappend files_to_open [lindex $argv $i]
! }
}
}
***************
*** 276,284 ****
proc poll_sock {} {
global sock sock_lobby
while {1} {
set cmd [gets $sock]
if {[eof $sock]} {
! tk_messageBox -message "my sock puppet disappeared (ah, the great mysteries of the washingmachine). Well, that's all, folks!" -type ok
! exit 42
}
if {[fblocked $sock]} {break}
--- 284,295 ----
proc poll_sock {} {
global sock sock_lobby
+ if {[llength $sock]==0} {return}
while {1} {
set cmd [gets $sock]
if {[eof $sock]} {
! #tk_messageBox -message "my sock puppet disappeared (ah, the great mysteries of the washingmachine). Well, that's all, folks!" -type ok
! #exit 42
! tk_messageBox -message "server gone boom" -type ok
! set sock {}
}
if {[fblocked $sock]} {break}
***************
*** 303,306 ****
--- 314,323 ----
fconfigure $sock -blocking 0 -buffering line
poll_sock
+ global files_to_open
+ foreach f $files_to_open {
+ set ff [file split $f]
+ set ffl [llength $ff]
+ pd "pd open [lindex $ff [expr $ffl-1]] [file join [lrange $ff 0 [expr $ffl-2]]] ;"
+ }
} {
puts "WTF, two pd kernels for one gui?"
***************
*** 308,313 ****
}
set server_sock [socket -server accept_pd 13666]
! exec pd -guiport 13666 &
################ utility functions #########################
--- 325,352 ----
}
+ proc poll_gdb {} {
+ global gdb
+ while {1} {
+ set line [gets $gdb]
+ if {[eof $gdb]} {tk_messageBox -message "eurggggh." -type ok; exit 69}
+ if {[fblocked $gdb]} {break}
+ post "\[gdb\] %s" $line
+ }
+ after 250 poll_gdb
+ }
+
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 #########################
***************
*** 571,575 ****
proc menu_pop_pd {} {
! puts"menu_pop_pd:::"
raise .
}
--- 610,614 ----
proc menu_pop_pd {} {
! puts "menu_pop_pd:::"
raise .
}
***************
*** 634,638 ****
{"Path..." {foo "pd start-path-dialog ;"} ""}
{}
! {"Quit" {foo menu_quit} "Ctrl+q"}
}
--- 673,677 ----
{"Path..." {foo "pd start-path-dialog ;"} ""}
{}
! {"Quit" {menu_quit} "Ctrl+q"}
}
***************
*** 652,655 ****
--- 691,697 ----
#set pd_nt 0
+ #-----------------------------------------------------------------------------------#
+ set look(iowidth) 7
+ set look(iopos) 1
set look(objectfg) #000000
set look(objectbg) #ffffff
***************
*** 687,694 ****
set pd_apilist "{ALSA 1}"
! proc pd {arg} {
global sock
! puts $sock $arg
! #puts "calling pd for $arg"
}
#-----------------------------------------------------------------------------------#
--- 729,736 ----
set pd_apilist "{ALSA 1}"
! proc pd {args} {
global sock
! puts $sock [join $args " "]
! puts "<- [join $args " "]"
}
#-----------------------------------------------------------------------------------#
***************
*** 796,815 ****
proc pdtk_canvas_editval {name value} {
puts "pdtk_canvas_editval::: $name $value"
-
global look _
set self [canvastosym $name.c]
!
!
! if {$value} {
! $name.m.edit entryconfigure "Edit mode" -indicatoron true
! catch {$name.bbar.edit configure -image icon_mode_edit}
! $name.c configure -background $look(canvasbgedit)
! set _($self:mode) edit
! } else {
! $name.m.edit entryconfigure "Edit mode" -indicatoron false
! catch {$name.bbar.edit configure -image icon_mode_run}
! $name.c configure -background $look(canvasbgrun)
! set _($self:mode) run
! }
}
--- 838,848 ----
proc pdtk_canvas_editval {name value} {
puts "pdtk_canvas_editval::: $name $value"
global look _
set self [canvastosym $name.c]
! $name.m.edit entryconfigure "Edit mode" -indicatoron $value
! set mode [if {$value} {list edit} {list run}]
! catch {$name.bbar.edit configure -image icon_mode_$mode}
! $name.c configure -background $look(canvasbg$mode)
! set _($self:mode) $mode
}
***************
*** 818,825 ****
# invisible (arg is ""). Invisibility means the Window Manager has minimized
# us. We don't get a final "unmap" event when we destroy the window.
! #proc pdtk_canvas_map {name} {pd [canvastosym $name] map 1 \;}
! #proc pdtk_canvas_unmap {name} {pd [canvastosym $name] map 0 \;}
! proc pdtk_canvas_map {name} {pd map}
! proc pdtk_canvas_unmap {name} {pd unmap}
#-----------------------------------------------------------------------------------#
--- 851,856 ----
# invisible (arg is ""). Invisibility means the Window Manager has minimized
# us. We don't get a final "unmap" event when we destroy the window.
! proc pdtk_canvas_map {name} {pd [canvastosym $name] map 1 \;}
! proc pdtk_canvas_unmap {name} {pd [canvastosym $name] map 0 \;}
#-----------------------------------------------------------------------------------#
***************
*** 1199,1206 ****
#-----------------------------------------------------------------------------------#
- set look(iowidth) 7
- set look(iopos) 1
-
- #-----------------------------------------------------------------------------------#
def io draw {canvas x1 y1 xs ys ins outs} {
puts "io_draw:: $self $canvas $x1 $y1 $xs $ys $ins $outs"
--- 1230,1233 ----
***************
*** 1240,1245 ****
def io erase {canvas} {
puts "io_erase:: $self $canvas"
! $canvas delete ${self}i
! $canvas delete ${self}o
}
--- 1267,1271 ----
def io erase {canvas} {
puts "io_erase:: $self $canvas"
! $canvas delete ${self}i ${self}o
}
***************
*** 1276,1288 ****
global look font
set name_len [string length $text]
!
if {[expr $@isnew == 1]} {
! brokenbox_draw $self $canvas \
! [expr ($font(width) * ($name_len+1) + $font(padx))] \
! [expr $font(height) + $font(pady)] 0 0
} {
! objectbox_draw $self $canvas \
! [expr ($font(width) * ($name_len+1) + $font(padx))] \
! [expr $font(height) + $font(pady)] 1 3
}
--- 1302,1311 ----
global look font
set name_len [string length $text]
! set sx [expr ($font(width) * ($name_len+1) + $font(padx))]
! set sy [expr $font(height) + $font(pady)]
if {[expr $@isnew == 1]} {
! brokenbox_draw $self $canvas $sx $sy 0 0
} {
! objectbox_draw $self $canvas $sx $sy 1 3
}
***************
*** 1325,1337 ****
#puts "name_len: $name_len"
#puts "$self:state -> $@state"
!
if {[expr $_($self:isnew) == 1]} {
! brokenbox_draw $self $canvas \
! [expr ($font(width) * ($name_len+1) + $font(padx))] \
! [expr $font(height) + $font(pady)] 0 0
} {
! objectbox_draw $self $canvas \
! [expr ($font(width) * ($name_len+1) + $font(padx))] \
! [expr $font(height) + $font(pady)] 1 3
}
}
--- 1348,1358 ----
#puts "name_len: $name_len"
#puts "$self:state -> $@state"
!
! set sx [expr ($font(width) * ($name_len+1) + $font(padx))]
! set sy [expr $font(height) + $font(pady)]
if {[expr $_($self:isnew) == 1]} {
! brokenbox_draw $self $canvas $sx $sy 0 0
} {
! objectbox_draw $self $canvas $sx $sy 1 3
}
}
***************
*** 3345,3354 ****
}
! proc tcl_eval {self l} {post %s "tcl: $l\nreturns: [eval $l]"}
! proc pd_eval {self l} {post %s "pd: $l\n"; pd "$l;\n"}
after 0 {
listener_new .tcl "Tcl" {tcl_eval}
listener_new .pd "Pd" {pd_eval}
}
--- 3366,3377 ----
}
! proc tcl_eval {self l} {post %s "tcl: $l"; post %s "returns: [eval $l]"}
! proc pd_eval {self l} {post %s "pd: $l"; pd "$l;\n"}
! 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)} {listener_new .gdb "Gdb" {gdb_eval}}
}
More information about the Pd-cvs
mailing list