mirror of
https://github.com/git/git
synced 2024-08-27 11:39:22 +00:00
git-gui: Teach class system to support [$this cmd] syntax
Its handy to be able to ask an object to do something for you by handing it a subcommand. For example if we want to get the value of an object's private field the object could expose a method that would return that value. Application level code can then invoke "$inst get" to perform the method call. Tk uses this pattern for all of its widgets, so we'd certainly like to use it for our own mega-widgets that we might develop. Up until now we haven't needed such functionality, but I'm working on a new revision picker mega-widget that would benefit from it. To make this work we have to change the definition of $this to actually be a procedure within the namespace. By making $this a procedure any caller that has $this can call subcommands by passing them as the first argument to $this. That subcommand then needs to call the proper subroutine. Placing the dispatch procedure into the object's variable namespace ensures that it will always be deleted when the object is deleted. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
This commit is contained in:
parent
4ca131250c
commit
6233ab1729
|
@ -5,7 +5,7 @@ proc class {class body} {
|
|||
if {[namespace exists $class]} {
|
||||
error "class $class already declared"
|
||||
}
|
||||
namespace eval $class {
|
||||
namespace eval $class "
|
||||
variable __nextid 0
|
||||
variable __sealed 0
|
||||
variable __field_list {}
|
||||
|
@ -13,10 +13,9 @@ proc class {class body} {
|
|||
|
||||
proc cb {name args} {
|
||||
upvar this this
|
||||
set args [linsert $args 0 $name $this]
|
||||
return [uplevel [list namespace code $args]]
|
||||
concat \[list ${class}::\$name \$this\] \$args
|
||||
}
|
||||
}
|
||||
"
|
||||
namespace eval $class $body
|
||||
}
|
||||
|
||||
|
@ -51,15 +50,16 @@ proc constructor {name params body} {
|
|||
set mbodyc {}
|
||||
|
||||
append mbodyc {set this } $class
|
||||
append mbodyc {::__o[incr } $class {::__nextid]} \;
|
||||
append mbodyc {namespace eval $this {}} \;
|
||||
append mbodyc {::__o[incr } $class {::__nextid]::__d} \;
|
||||
append mbodyc {create_this } $class \;
|
||||
append mbodyc {set __this [namespace qualifiers $this]} \;
|
||||
|
||||
if {$__field_list ne {}} {
|
||||
append mbodyc {upvar #0}
|
||||
foreach n $__field_list {
|
||||
set n [lindex $n 0]
|
||||
append mbodyc { ${this}::} $n { } $n
|
||||
regsub -all @$n\\M $body "\${this}::$n" body
|
||||
append mbodyc { ${__this}::} $n { } $n
|
||||
regsub -all @$n\\M $body "\${__this}::$n" body
|
||||
}
|
||||
append mbodyc \;
|
||||
foreach n $__field_list {
|
||||
|
@ -80,10 +80,12 @@ proc method {name params body {deleted {}} {del_body {}}} {
|
|||
set params [linsert $params 0 this]
|
||||
set mbodyc {}
|
||||
|
||||
append mbodyc {set __this [namespace qualifiers $this]} \;
|
||||
|
||||
switch $deleted {
|
||||
{} {}
|
||||
ifdeleted {
|
||||
append mbodyc {if {![namespace exists $this]} }
|
||||
append mbodyc {if {![namespace exists $__this]} }
|
||||
append mbodyc \{ $del_body \; return \} \;
|
||||
}
|
||||
default {
|
||||
|
@ -98,10 +100,12 @@ proc method {name params body {deleted {}} {del_body {}}} {
|
|||
if { [regexp -all -- $n\\M $body] == 1
|
||||
&& [regexp -all -- \\\$$n\\M $body] == 1
|
||||
&& [regexp -all -- \\\$$n\\( $body] == 0} {
|
||||
regsub -all \\\$$n\\M $body "\[set \${this}::$n\]" body
|
||||
regsub -all \
|
||||
\\\$$n\\M $body \
|
||||
"\[set \${__this}::$n\]" body
|
||||
} else {
|
||||
append decl { ${this}::} $n { } $n
|
||||
regsub -all @$n\\M $body "\${this}::$n" body
|
||||
append decl { ${__this}::} $n { } $n
|
||||
regsub -all @$n\\M $body "\${__this}::$n" body
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -112,11 +116,21 @@ proc method {name params body {deleted {}} {del_body {}}} {
|
|||
namespace eval $class [list proc $name $params $mbodyc]
|
||||
}
|
||||
|
||||
proc create_this {class} {
|
||||
upvar this this
|
||||
namespace eval [namespace qualifiers $this] [list proc \
|
||||
[namespace tail $this] \
|
||||
[list name args] \
|
||||
"eval \[list ${class}::\$name $this\] \$args" \
|
||||
]
|
||||
}
|
||||
|
||||
proc delete_this {{t {}}} {
|
||||
if {$t eq {}} {
|
||||
upvar this this
|
||||
set t $this
|
||||
}
|
||||
set t [namespace qualifiers $t]
|
||||
if {[namespace exists $t]} {namespace delete $t}
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in a new issue