'''my oh my''' is a response to a question by [jbr] in [Ask, and it shall be given # 11]



** In tcloo can I create a new "slot" type class variable? **

Specifically I'd like to create a "method" declaration adjective, similar to "public" and "private" from [JBR's tcloo.tcl].  The adjective I'm thinking of is "linked" that will
perform the function of the "procs" procedure in tcloo.tcl, and is called "link" in some other code (forgot where ([PYK]:  probably in [ooutil])).  It links procs in an object's namespace to the class
methods such that they can be called as commands.

The current implementations require the set of linked methods to be mentioned twice, once in their method declarations and once in the link/procs call in the class 
constructor.  I'd like something like:

    linked method name { args } { body }

The linked method would add the method name to the classes linked slot and then at constructor time (maybe automatically) the links would be made using the "linked" slot list.  Is it possible to 
override or filter the class constructor to handle this automatic at constructor time part?  Without subclassing??
  
Ideas??

Thanks - [JBR]



** my oh my **

[PYK] 2014-06-11: I put together a mixin class that tries to do what you've
described.  The purpose of `[string map]` here is to find a nice private
location for the bookkeeping that is done to track the `my` methods.  It's a
little ugly, but hey, it works.

Using `[namespace unknown]` as the redirector was the only way I could find at
the script level to get this job done.

Overloading the word `my` for this purpose leads to a heaping helping of `my`,
but other ideas such as `my!` and `nomy` seemed even more forced.  Better ideas
are welcome, and anyone wants to improve this code, please just dig in!


======
oo::class create my

{*}[string map [list {{{my}}} [list [
    info object namespace [::oo::object new]]]] {apply {{} {

    oo::define my constructor args {
        namespace eval [self namespace] {
            namespace unknown [list apply [list args {
                set clsns [uplevel {info object namespace [self class]}]
                if {[lindex $args 0] in [set {{my}}::${clsns}::my]} {
                    return [uplevel [list my {*}$args]]
                }
                return -code error [list {not found} $args]
            }]]
        }
    }

    proc oo::define::my {method name margs body} {
        uplevel [list method $name $margs $body]
        set clsname [lindex [info level -1] 1]
        set ns [uplevel [list info object namespace $clsname]]
        namespace eval {{my}}::$ns {}
        lappend {{my}}::${ns}::my $name

    }
}}}]
======

example:


======
oo::class create class1
oo::define class1 {
    mixin -append my
    my method method1 args {
        return {hi from method1}
    }
    method method2 args {
        method1
    }
}

class1 create inst1
puts [inst1 method2]
======


[JBR] - OK Building on [PYK]'s answer above I'll propose this chain of mixin constructors:

 oo::class create __linked {
    constructor { args } {
        # Don't know if the class has a constructor, catch a bad call
        #
        catch { next {*}$args }

        # Create the links
        #
        foreach link [set [[info object class [self]] varname __linked]] {
            proc [namespace current]::$link args [subst { tailcall my $link {*}\$args }]
        }
    }
 }
 oo::class create _linked {
    variable __linked

    constructor { args } {
        set __linked {}

        next {*}$args

        oo::define [self] { mixin -append __linked }
    }
 }

 oo::define oo::class {
    mixin -append _linked
 }
 proc oo::define::linked { args } {
    set class [lindex [info level -1] 1]
    oo::define $class { self export varname }

    if { [lindex $args 0] ne "method" } {
        set method [lindex $args 2]             ; # Skip over public / private
    } else {
        set method [lindex $args 1]
    }

    lappend [$class varname __linked] $method   ; # remember linked methods

    uplevel 1 $args
 }

 oo::class create foo {
    linked method method2 { y } { puts $y }

    method method1 { y } {
        puts "[namespace current]"
        method2 $y
    }
 }

 foo create inst
 inst method2 1

<<categories>> my