[PD-cvs] pd/src desire.tk, 1.1.2.417, 1.1.2.418 objective.tcl, 1.1.2.17, 1.1.2.18
Mathieu Bouchard
matju at users.sourceforge.net
Tue Aug 29 02:07:19 CEST 2006
Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20165
Modified Files:
Tag: devel_0_39
desire.tk objective.tcl
Log Message:
new: proc tracedef, which is the decoupling of def and def*
also loads debug.tcl, which is where tracedef calls should go
Index: desire.tk
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/desire.tk,v
retrieving revision 1.1.2.417
retrieving revision 1.1.2.418
diff -C2 -d -r1.1.2.417 -r1.1.2.418
*** desire.tk 28 Aug 2006 23:44:21 -0000 1.1.2.417
--- desire.tk 29 Aug 2006 00:07:17 -0000 1.1.2.418
***************
*** 38,49 ****
package require objective
! catch {
! set cmds [info commands]
! puts "Tclx version [package require Tclx]"
! set cmds [lsort [lwithout [info commands] $cmds]]
! puts "Tclx has got $cmds"
! }
!
! #catch {source profdd.tcl}
proc which {file} {
--- 38,43 ----
package require objective
! #if {[catch {source profdd.tcl}]} {error_dump}
! if {[catch {source debug.tcl}]} {error_dump}
proc which {file} {
***************
*** 172,188 ****
class_new Manager {Thing}
! def* Manager init {} {
! set @q [list]
$self call
}
- proc error_dump {} {
- global errorCode errorInfo
- regsub -all " invoked from within\n" $errorInfo "" errorInfo
- regsub -all "\n \\(" $errorInfo " (" errorInfo
- #regsub -all {\n[^\n]*procedure \"(::unknown|super)\"[^\n]*\n} $errorInfo "\n" errorInfo
- puts "[VTred]Exception:[VTgrey] errorCode=$errorCode; errorInfo=$errorInfo"
- }
-
def Manager call {} {
global poolset
--- 166,174 ----
class_new Manager {Thing}
! def Manager init {} {
! set @q {}
$self call
}
def Manager call {} {
global poolset
***************
*** 753,759 ****
set sock_lobby {}
- proc VTred {} {return "\x1b\[0;1;31m"}
- proc VTgrey {} {return "\x1b\[0m"}
-
proc poll_sock {} {
global sock sock_lobby
--- 739,742 ----
***************
*** 997,1001 ****
}
! def* Menuable ctrlkey {key shift} {
global accels
set key [if {$shift} {string toupper $key} {string tolower $key}]
--- 980,984 ----
}
! def Menuable ctrlkey {key shift} {
global accels
set key [if {$shift} {string toupper $key} {string tolower $key}]
***************
*** 1072,1075 ****
--- 1055,1059 ----
}
}
+ puts "category = $category"
set_fontstring
***************
*** 1137,1145 ****
def View noutlets= {v} {set @noutlets $v}
def View noutlets {} {return $@noutlets}
! def* View click {x y f target} {}
! def* View unclick {x y f target} {}
! def View motion {x y f target} {}
! def* View look {k} {
global look
if {[info exists look($@_class:$k)]} {
--- 1121,1129 ----
def View noutlets= {v} {set @noutlets $v}
def View noutlets {} {return $@noutlets}
! def View click {x y f target} {}
! def View unclick {x y f target} {}
! def View motion {x y f target} {}
! def View look {k} {
global look
if {[info exists look($@_class:$k)]} {
***************
*** 1202,1213 ****
default {.$@canvas.c delete $self$suffix}}}
! def* View draw {} {}
! def* View delete {} {$self erase}
! def* View erase {} {$self item_delete}
def View selected? {} {return $@selected?}
def View selected?= {x} {set @selected? $x; $self changed} ;# only call this from selection= and such
! def* View select {state} {
set ostate [$self selected?]
set @selected? $state
--- 1186,1197 ----
default {.$@canvas.c delete $self$suffix}}}
! def View draw {} {}
! def View delete {} {$self erase}
! def View erase {} {$self item_delete}
def View selected? {} {return $@selected?}
def View selected?= {x} {set @selected? $x; $self changed} ;# only call this from selection= and such
! def View select {state} {
set ostate [$self selected?]
set @selected? $state
***************
*** 1225,1229 ****
}
! #def* View popup_properties {} {
# global fields
# set class $@class
--- 1209,1213 ----
}
! #def View popup_properties {} {
# global fields
# set class $@class
***************
*** 1357,1361 ****
$self changed ;#$self draw
}
! def* Canvas editmodeswitch {args} {
global crosshair
set @editmode [expr !$@editmode]
--- 1341,1345 ----
$self changed ;#$self draw
}
! def Canvas editmodeswitch {args} {
global crosshair
set @editmode [expr !$@editmode]
***************
*** 1482,1486 ****
def Canvas history {} {return $@history}
! def* Canvas font_bomb {} {FontBombDialog new_as fontbomb}
#-----------------------------------------------------------------------------------#
--- 1466,1470 ----
def Canvas history {} {return $@history}
! def Canvas font_bomb {} {FontBombDialog new_as fontbomb}
#-----------------------------------------------------------------------------------#
***************
*** 1572,1576 ****
def Canvas reload {} {pd ".$self map 0; .$self map 1"}
! def* Canvas redraw {} {
$self changed
foreach x $@children {$x changed}
--- 1556,1560 ----
def Canvas reload {} {pd ".$self map 0; .$self map 1"}
! def Canvas redraw {} {
$self changed
foreach x $@children {$x changed}
***************
*** 1687,1691 ****
}
! def* Canvas draw {} {
if {$@subpatch} {super} ;# is for the [pd] box if applicable
if {$@editmode} {set bg [$self look bgedit]} else {set bg [$self look bgrun]}
--- 1671,1675 ----
}
! def Canvas draw {} {
if {$@subpatch} {super} ;# is for the [pd] box if applicable
if {$@editmode} {set bg [$self look bgedit]} else {set bg [$self look bgrun]}
***************
*** 1694,1698 ****
}
! def* Canvas popup_properties {} {CanvasPropertiesDialog new $self}
#-----------------------------------------------------------------------------------#
--- 1678,1682 ----
}
! def Canvas popup_properties {} {CanvasPropertiesDialog new $self}
#-----------------------------------------------------------------------------------#
***************
*** 1710,1714 ****
def TextBox text {} {return $text}
! def* TextBox draw {} {
global font
#$self update_size
--- 1694,1698 ----
def TextBox text {} {return $text}
! def TextBox draw {} {
global font
#$self update_size
***************
*** 1732,1736 ****
def Canvas obj_in_edit= {v} {set @obj_in_edit $v}
! def* TextBox edit {} {
global font
if {$@edit} {return}
--- 1716,1720 ----
def Canvas obj_in_edit= {v} {set @obj_in_edit $v}
! def TextBox edit {} {
global font
if {$@edit} {return}
***************
*** 1764,1768 ****
}
! def* TextBox key {widget x y key iso shift} {
after 0 "$self after_key $widget"
switch -- $key {
--- 1748,1752 ----
}
! def TextBox key {widget x y key iso shift} {
after 0 "$self after_key $widget"
switch -- $key {
***************
*** 1847,1851 ****
}
! def* ObjectBox draw_box {} {
global font
super
--- 1831,1835 ----
}
! def ObjectBox draw_box {} {
global font
super
***************
*** 2015,2019 ****
}
! def* View set_orig_xy {x y} {
set @orig_x $x
set @orig_y $y
--- 1999,2003 ----
}
! def View set_orig_xy {x y} {
set @orig_x $x
set @orig_y $y
***************
*** 2073,2077 ****
}
! def* Canvas quadrant {du dv array} {
switch $@keynav_current { 0 {set @keynav_current [lindex $@children 0]}}
set foo {}
--- 2057,2061 ----
}
! def Canvas quadrant {du dv array} {
switch $@keynav_current { 0 {set @keynav_current [lindex $@children 0]}}
set foo {}
***************
*** 2332,2336 ****
}
! def* Canvas disconnect {wire} {
mset {from outlet to inlet} $wire; pd .$self disconnect $from $outlet $to $inlet
$@history add [list $self connect $wire]
--- 2316,2320 ----
}
! def Canvas disconnect {wire} {
mset {from outlet to inlet} $wire; pd .$self disconnect $from $outlet $to $inlet
$@history add [list $self connect $wire]
***************
*** 2388,2392 ****
$self motion $@x1 $@y1 $f $target
}
! def* FutureWire motion {x y f target} {
set @x2 $x
set @y2 $y
--- 2372,2376 ----
$self motion $@x1 $@y1 $f $target
}
! def FutureWire motion {x y f target} {
set @x2 $x
set @y2 $y
***************
*** 2400,2404 ****
$self draw
}
! def* FutureWire unclick {x y f target} {
$self motion $x $y $f $target
if {$@to != ""} {
--- 2384,2388 ----
$self draw
}
! def FutureWire unclick {x y f target} {
$self motion $x $y $f $target
if {$@to != ""} {
***************
*** 2588,2592 ****
}
! def* Canvas tab_jump {} {
set @keynav 1
#puts " selection:::: [$self selection]"
--- 2572,2576 ----
}
! def Canvas tab_jump {} {
set @keynav 1
#puts " selection:::: [$self selection]"
***************
*** 2658,2662 ****
proc overlap {y0 y1 x0 x1} {return [expr [inside $y0 $x0 $x1] || [inside $y1 $x0 $x1]]}
! def* Canvas key_nav {du dv shift} {
#puts " keynav_tab_sel::: $@keynav_tab_sel"
#puts " selection_wire::: $@selection_wire"
--- 2642,2646 ----
proc overlap {y0 y1 x0 x1} {return [expr [inside $y0 $x0 $x1] || [inside $y1 $x0 $x1]]}
! def Canvas key_nav {du dv shift} {
#puts " keynav_tab_sel::: $@keynav_tab_sel"
#puts " selection_wire::: $@selection_wire"
***************
*** 2752,2756 ****
}
! def* Canvas key_nav_ioselect {} {
if {[llength $@selection] == 1} {
set var [lindex $@keynav_iosel end end]
--- 2736,2740 ----
}
! def Canvas key_nav_ioselect {} {
if {[llength $@selection] == 1} {
set var [lindex $@keynav_iosel end end]
***************
*** 2961,2966 ****
# will be so that @wires are updated correctly without breaking encapsulation
! def* Box connect_out {} {}
! def* Box connect_in {} {}
def Box draw {} {
--- 2945,2950 ----
# will be so that @wires are updated correctly without breaking encapsulation
! def Box connect_out {} {}
! def Box connect_in {} {}
def Box draw {} {
***************
*** 2970,2975 ****
}
def Box draw_box {} {}
! def* Box edit {} {}
! def* Box unedit {} {}
def Box bbox {} {
--- 2954,2959 ----
}
def Box draw_box {} {}
! def Box edit {} {}
! def Box unedit {} {}
def Box bbox {} {
***************
*** 2981,2985 ****
def Box draw_wires {} {foreach wire $@wires {$wire draw}}
! def* Box delete_wire {wire} {
set find [lsearch $@wires $wire]
if {$find != -1} {set @wires [lreplace $@wires $find $find]}
--- 2965,2969 ----
def Box draw_wires {} {foreach wire $@wires {$wire draw}}
! def Box delete_wire {wire} {
set find [lsearch $@wires $wire]
if {$find != -1} {set @wires [lreplace $@wires $find $find]}
***************
*** 3007,3011 ****
}
! def* Box clickedit {x y butt key in_selection selection} {
if {($key&1) && $selection>0} {puts "add $self to selection...."}
#if clicked obj is part of the $@selection, than....
--- 2991,2995 ----
}
! def Box clickedit {x y butt key in_selection selection} {
if {($key&1) && $selection>0} {puts "add $self to selection...."}
#if clicked obj is part of the $@selection, than....
***************
*** 3114,3118 ****
def Wire report {} {list $@obj1 $@port1 $@obj2 $@port2}
! def* Wire draw {} {
set zoom [$@canvas zoom]
set bbox1 [lmap / [.$@canvas.c bbox [join [list "$@obj1" o "$@port1"] ""]] $zoom]
--- 3098,3102 ----
def Wire report {} {list $@obj1 $@port1 $@obj2 $@port2}
! def Wire draw {} {
set zoom [$@canvas zoom]
set bbox1 [lmap / [.$@canvas.c bbox [join [list "$@obj1" o "$@port1"] ""]] $zoom]
***************
*** 3680,3684 ****
}
! def* FloatAtom key {key shift} {
global font
if {[super $key $shift]} {return}
--- 3664,3668 ----
}
! def FloatAtom key {key shift} {
global font
if {[super $key $shift]} {return}
***************
*** 3696,3700 ****
}
! def* SymbolAtom key {key shift} {
global font
if {[super $key $shift]} {return}
--- 3680,3684 ----
}
! def SymbolAtom key {key shift} {
global font
if {[super $key $shift]} {return}
***************
*** 3706,3710 ****
}
! def* FloatAtom ftoa {} {
set f $@val
set is_exp 0
--- 3690,3694 ----
}
! def FloatAtom ftoa {} {
set f $@val
set is_exp 0
***************
*** 4248,4252 ****
}
! def* Vu set {i j} {
set @value $i
set @peak $j
--- 4232,4236 ----
}
! def Vu set {i j} {
set @value $i
set @peak $j
***************
*** 4656,4663 ****
def Completion init {name x y textbox} {super $name $x $y $textbox}
! def* ClassBrowser cancel {} {$self delete}
! def* ClassBrowser delete {} {set @exist 0; super}
! def* ClassBrowser init {name x y textbox} {
#super
set @name $name
--- 4640,4647 ----
def Completion init {name x y textbox} {super $name $x $y $textbox}
! def ClassBrowser cancel {} {$self delete}
! def ClassBrowser delete {} {set @exist 0; super}
! def ClassBrowser init {name x y textbox} {
#super
set @name $name
***************
*** 4672,4676 ****
}
! def* ClassBrowser fill_box {s} {
global class_list
$@listbox delete 0 end
--- 4656,4660 ----
}
! def ClassBrowser fill_box {s} {
global class_list
$@listbox delete 0 end
***************
*** 4686,4695 ****
}
! def* Completion fill_box {s} {
super $s
wm maxsize .$self [winfo reqwidth .$self.comp] [winfo reqheight .$self.comp]
}
! def* Browser fill_box {s} {
global class_list
super $s
--- 4670,4679 ----
}
! def Completion fill_box {s} {
super $s
wm maxsize .$self [winfo reqwidth .$self.comp] [winfo reqheight .$self.comp]
}
! def Browser fill_box {s} {
global class_list
super $s
***************
*** 4712,4716 ****
}
! def* ClassBrowser info {listbox} {
set i [$listbox curselection]
set class [string range [lindex [$listbox get $i] 0] 1 end-1]
--- 4696,4700 ----
}
! def ClassBrowser info {listbox} {
set i [$listbox curselection]
set class [string range [lindex [$listbox get $i] 0] 1 end-1]
***************
*** 4718,4722 ****
}
! def* Browser list_callback {} {
global class_list font
$self search_for_externs
--- 4702,4706 ----
}
! def Browser list_callback {} {
global class_list font
$self search_for_externs
***************
*** 4757,4761 ****
}
! def* Completion list_callback {} {
global class_list
$self search_for_externs
--- 4741,4745 ----
}
! def Completion list_callback {} {
global class_list
$self search_for_externs
***************
*** 4831,4835 ****
}
! def* ClassBrowser key {key focus1 {shift 0}} {
#focus1 = whatever
if {[regexp {x([0-9a-z]{6,8})text$} $@textbox textself]} {
--- 4815,4819 ----
}
! def ClassBrowser key {key focus1 {shift 0}} {
#focus1 = whatever
if {[regexp {x([0-9a-z]{6,8})text$} $@textbox textself]} {
***************
*** 5148,5152 ****
}
! def* Dialog add_fontbomb {f args} {
global look
if {[winfo exists $f.font]} {return}
--- 5132,5136 ----
}
! def Dialog add_fontbomb {f args} {
global look
if {[winfo exists $f.font]} {return}
***************
*** 5327,5331 ****
def Dialog delete {} {destroy .$self; super}
! def* Dialog init {args} {
super
set f .$self
--- 5311,5315 ----
def Dialog delete {} {destroy .$self; super}
! def Dialog init {args} {
super
set f .$self
***************
*** 5347,5351 ****
}
! def* Dialog dropmenu_open {frame} {
set x [winfo rootx $frame.butt]
set y [expr [winfo height $frame.butt] + [winfo rooty $frame.butt]]
--- 5331,5335 ----
}
! def Dialog dropmenu_open {frame} {
set x [winfo rootx $frame.butt]
set y [expr [winfo height $frame.butt] + [winfo rooty $frame.butt]]
***************
*** 5353,5362 ****
}
! def* Dialog dropmenu_set {frame var part val} {
$frame.butt configure -text [say $part]
set @$var $val
}
! def* Dialog color_popup_select {frame var color} {
set @$var $color
set col [format #%6.6x $color]
--- 5337,5346 ----
}
! def Dialog dropmenu_set {frame var part val} {
$frame.butt configure -text [say $part]
set @$var $val
}
! def Dialog color_popup_select {frame var color} {
set @$var $color
set col [format #%6.6x $color]
***************
*** 5364,5368 ****
}
! def* Dialog color_popup {frame var i} {
set w $frame.color.popup
if [winfo exists $w] {destroy $w}
--- 5348,5352 ----
}
! def Dialog color_popup {frame var i} {
set w $frame.color.popup
if [winfo exists $w] {destroy $w}
***************
*** 5378,5382 ****
}
! def* Dialog choose_col {frame var val} {
set c 0xFFFFFF
set color [tk_chooseColor -title $val -initialcolor $val]
--- 5362,5366 ----
}
! def Dialog choose_col {frame var val} {
set c 0xFFFFFF
set color [tk_chooseColor -title $val -initialcolor $val]
***************
*** 5555,5559 ****
def ServerPrefsDialog apply {} {$self write}
! def* ServerPrefsDialog init_reverse_hash {} {
global pdrc_options pdrc_options_h
foreach {type names} $pdrc_options {
--- 5539,5543 ----
def ServerPrefsDialog apply {} {$self write}
! def ServerPrefsDialog init_reverse_hash {} {
global pdrc_options pdrc_options_h
foreach {type names} $pdrc_options {
***************
*** 5564,5568 ****
}
! def* ServerPrefsDialog read {} {
global pdrc_options pdrc_options_h cmdline
set fd [open $cmdline(rcfilename) "RDONLY CREAT"]
--- 5548,5552 ----
}
! def ServerPrefsDialog read {} {
global pdrc_options pdrc_options_h cmdline
set fd [open $cmdline(rcfilename) "RDONLY CREAT"]
***************
*** 5614,5620 ****
# puts "THE END"
}
! def* ServerPrefsDialog reset {} {
}
! def* ServerPrefsDialog init {} {
puts " clsee:: $@_class"
global pdrc_options
--- 5598,5604 ----
# puts "THE END"
}
! def ServerPrefsDialog reset {} {
}
! def ServerPrefsDialog init {} {
puts " clsee:: $@_class"
global pdrc_options
***************
*** 5723,5727 ****
def ClientPrefsDialog apply {} {$self write}
! def* ClientPrefsDialog read {} {
global ddrc_options cmdline look key
set fd [open $cmdline(ddrcfilename) "RDONLY CREAT"]
--- 5707,5711 ----
def ClientPrefsDialog apply {} {$self write}
! def ClientPrefsDialog read {} {
global ddrc_options cmdline look key
set fd [open $cmdline(ddrcfilename) "RDONLY CREAT"]
***************
*** 5745,5749 ****
}
! def* ClientPrefsDialog read2 {} {
global ddrc_options ddrc_options_h cmdline look key crosshair bar
set fd [open $cmdline(ddrcfilename) "RDONLY CREAT"]
--- 5729,5733 ----
}
! def ClientPrefsDialog read2 {} {
global ddrc_options ddrc_options_h cmdline look key crosshair bar
set fd [open $cmdline(ddrcfilename) "RDONLY CREAT"]
***************
*** 5785,5789 ****
#this writes the ddrc
! def* ClientPrefsDialog write {} {
global ddrc_options cmdline look accels key
$self get_val
--- 5769,5773 ----
#this writes the ddrc
! def ClientPrefsDialog write {} {
global ddrc_options cmdline look accels key
$self get_val
***************
*** 5835,5839 ****
#this retrives the values set in the editor
! def* ClientPrefsDialog get_val {} {
global ddrc_options look key
set check_key {}
--- 5819,5823 ----
#this retrives the values set in the editor
! def ClientPrefsDialog get_val {} {
global ddrc_options look key
set check_key {}
***************
*** 5891,5895 ****
}
! def* ClientPrefsDialog write2 {} {
global ddrc_options ddrc_options_h cmdline look accels key crosshair
set fd [open $cmdline(ddrcfilename) w]
--- 5875,5879 ----
}
! def ClientPrefsDialog write2 {} {
global ddrc_options ddrc_options_h cmdline look accels key crosshair
set fd [open $cmdline(ddrcfilename) w]
***************
*** 5939,5945 ****
}
! def* ClientPrefsDialog reset {} {
}
! def* ClientPrefsDialog init {} {
global ddrc_options look key crosshair bar
$self read
--- 5923,5929 ----
}
! def ClientPrefsDialog reset {} {
}
! def ClientPrefsDialog init {} {
global ddrc_options look key crosshair bar
$self read
***************
*** 6054,6058 ****
class_new FontBombDialog {Dialog}
! def* FontBombDialog apply {} {
global look
$self font_get_xlfd .$self $@font $@style $@size
--- 6038,6042 ----
class_new FontBombDialog {Dialog}
! def FontBombDialog apply {} {
global look
$self font_get_xlfd .$self $@font $@style $@size
***************
*** 6070,6074 ****
}
! def* FontBombDialog init {} {
global font
super cancel ok
--- 6054,6058 ----
}
! def FontBombDialog init {} {
global font
super cancel ok
***************
*** 6292,6296 ****
}
! def* View deconstruct_to {stream args} {
$stream << [eval [concat [list $self deconstruct] $args]]
$stream << ";\n"
--- 6276,6280 ----
}
! def View deconstruct_to {stream args} {
$stream << [eval [concat [list $self deconstruct] $args]]
$stream << ";\n"
Index: objective.tcl
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/objective.tcl,v
retrieving revision 1.1.2.17
retrieving revision 1.1.2.18
diff -C2 -d -r1.1.2.17 -r1.1.2.18
*** objective.tcl 20 Aug 2006 21:46:59 -0000 1.1.2.17
--- objective.tcl 29 Aug 2006 00:07:17 -0000 1.1.2.18
***************
*** 42,47 ****
proc def {self selector args body} {
! global _; if {![info exists _($self:_class)]} {error "unknown class '$self'"}
! proc ${self}_$selector "self $args" "global _; [expand_macros $body]"
}
proc def* {self selector args body} {
--- 42,53 ----
proc def {self selector args body} {
! global _ __trace
! if {![info exists _($self:_class)]} {error "unknown class '$self'"}
! if {[info exists __trace($self:$selector)]} {
! proc* ${self}_$selector "self $args" "global _; [expand_macros $body]"
! } {
! proc ${self}_$selector "self $args" "global _; [expand_macros $body]"
! }
! #trace add execution ${self}_$selector enter dedebug
}
proc def* {self selector args body} {
***************
*** 150,153 ****
--- 156,160 ----
def Class ancestors {} {
+ #if {[info exists @ancestors]} {}
set r [list $self]
foreach super $@_super {eval [concat [list lappend r] [$super ancestors]]}
***************
*** 160,161 ****
--- 167,183 ----
#-----------------------------------------------------------------------------------#
+
+ proc VTred {} {return "\x1b\[0;1;31m"}
+ proc VTgrey {} {return "\x1b\[0m"}
+ proc error_dump {} {
+ global errorCode errorInfo
+ regsub -all " invoked from within\n" $errorInfo "" errorInfo
+ regsub -all "\n \\(" $errorInfo " (" errorInfo
+ #regsub -all {\n[^\n]*procedure \"(::unknown|super)\"[^\n]*\n} $errorInfo "\n" errorInfo
+ puts "[VTred]Exception:[VTgrey] errorCode=$errorCode; errorInfo=$errorInfo"
+ }
+
+ proc tracedef {class method {when enter}} {
+ global __trace
+ set __trace($class:$method) $when
+ }
More information about the Pd-cvs
mailing list