if 0 {

[PYK] 2016-09-06:  [namespace%|%namespaces] had their genesis in a
converstation at a Tcl conference about what a common foundation for all the
existing Tcl object systems would look like.  Since then (well, and long before
then), Tcl programmers have amused themselves with attempts to create the most
minimal and [elegance%|%elegant] object systems.  An object is a collection of
related data, along with a set of commands that operate on that data.  An
[object orientation%|%object system] exists to facilitate the composition and
operation of such objects.  [wjd%|%Will Duquette] once published
[http://www.wjduquette.com/tcl/objects.html%|%Creating Object Commands], which
I found quite informative somewhere along my way into Tcl, and from there have
distilled into an updated take on how to create such systems.  This walkthrough
serves both as a tutorial on creating a particular object system, and as an
introduction to the facilities provided by `[namespace]`.

The primary principles of the system presented below are:

   * A [namespace ensemble] is the name of the object, as well as of the namespace that represents the object.

   * Each object command is registered in the [namespace ensemble] map such that a call to object command is a call to a dispatcher that resolves and calls the actual command, passing it the name of the current object.

   * namespaces that contribute commands to the object are accessed through the [namespace path] of the object. 


Given the features of `[namespace]`, one question is particularly vexing: How
to arrange for access to the current object from within an object command.
Ideally, there would be a `namespace ensemble current`, which returned the name
of the closest active namespace ensemble.  One might simply put the object
commands in the namespace representing the object, which would allow access to
the object data using standard commands like `[variable]`, but that requires
duplicating commands for each object, which is no fun.  This leaves either the
ensemble map or the `[namespace unknown]` mechanism as alternatives.

To illustrate how to put all the pieces of the object system together.  This
article walks throught the implementation of implement a timer.  Most of the
system is implemented in the command that creates the objects. `$_` is the name
of the object.  The command to create new timers is a regular procedure, not a
namespace ensemble:
======
}

namespace eval timer {

    proc [namespace current] name {
        set _ [uplevel 1 [list namespace eval $name {namespace current}]]
        namespace eval $_ {

            ::apply [list {} {
                foreach action {elapsed lap running start stop} {
                    dict set map $action [list ::apply [list {_ action args} {
                        tailcall $action $_ {*}$args
                    } [namespace current]] [namespace current] $action]
                }
                namespace ensemble create -map $map 
            } [namespace current]]

            # Initialize the object data
            variable elapsed [expr 0]
            variable running [expr 0]
            variable start [expr -1]
            namespace current
        }
        namespace eval $name [list namespace path [list [
            namespace current]::[namespace tail [lindex [info level 0] 0]] {*}[namespace eval $name {namespace path}]]]
        return $_
    }

    # [start], [stop], [elapsed], and [running] will live in this namespace as well

}

if 0 {
======

`[apply]` and `[tailcall]` are used to avoid adding an extra level to the
interpreter when the subcommand is called.  If `[namespace code]` didn't add
that level, the above could be written like this instead:

======
# This code is a non-working example
if 0 {
    namespace ensemble create -map  [dict create \
        elapsed [namespace code elapsed [namespace current] {*}$args] \
        running [namespace code running [namespace current] {*}$args] \
        start [namespace code start [namespace current] {*}$args] \
        stop [namespace code stop [namespace current] {*}$args] \
    ]
}
======

To create a new timer:

======
}
timer timer1
if 0 {
======

The next step is to implement the commands.  Although `timer1` already exists
as these commands are created, they implement the functionality of `timer1`:
======
}

namespace eval timer {

    proc lap _ {
        namespace upvar $_ elapsed elapsed start start
        expr {[clock clicks] - $start}
    }

    proc elapsed _ {
        namespace upvar $_ elapsed elapsed
        $_ stop
        $_ start
        return $elapsed
    }

    proc running _ {
        namespace upvar $_ running running
        return $running
    }

    proc stop _ {
        namespace upvar $_ elapsed elapsed running running start start
        set running [expr 0]
        set elapsed [expr {$elapsed + [$_ lap]}] 
        set start [expr -1]
        return $elapsed
    }

    proc start _ {
        namespace upvar $_ running running start start
        if {$start == -1} {
            set start [clock clicks]
        }
    }
}
if 0 {
======

`[namespace upvar]` is used to access object data.  Here are the remaining commands:

Now, to test it out:

======
}
timer1 start
after 2000
puts [timer1 elapsed]

if 0 {
======

Deriving another kind of timer from this one is a matter of manipulating the
map and the `[namespace path]` in the new timer creator:

======
}
namespace eval vartimer {
    proc [namespace current] name {
        set _ [uplevel 1 [list [namespace which timer] $name]]
        namespace eval $_ [list namespace path [list [
            namespace current]::[namespace tail [lindex [info level 0] 0]] {*}[namespace eval $_ {namespace path}]]]
        set map [namespace ensemble configure $_ -map]
        foreach action {faster slower} {
            dict set map $action [list ::apply [list {_ action args} {
                tailcall $action $_ {*}$args
            } $_] $_ $action]
        }
        namespace ensemble configure $_ -map $map
        namespace eval $_ {
            variable factor 1.0
        }
        return $_
    }

}
namespace eval vartimer {
    proc faster _ {
        namespace upvar $_ factor factor
        set factor [expr {$factor * 1.25}]
    }
    proc slower _ {
        namespace upvar $_ factor factor
        set factor [expr {$factor * .25}]
    }

    proc lap _ {
        namespace upvar $_ factor factor
        namespace upvar $_ elapsed upelapsed
        set lap [[namespace which timer]::lap $_]
        set upelapsed [expr {$upelapsed + ($lap * $factor)}]
    }
}


if 0 {
======

Now to try it out:

======
}
vartimer timer2
timer2 faster
timer2 faster
timer2 start
after 2000
puts [timer2 elapsed]

if 0 {
======

Now comes the fun part:  Taking the functionality sketched out above and
packaging it into a general system that's convenient to use.  This increased
the complexity of the implementation, of course, but will make it easier to
compose and manage objects.  To make something that's friendly to use, as well
as more orthogonal, a few things will have to change.  First, the basic
functionality is encapsulated into a primordial object, the thing from which
all other objects spring.  This object will be a `[namespace ensemble]`, so it
will no longer be possible to call it directly to create new objects.  Instead,
it will have an object command, `new`, for that purpose.  The two most basic
things an object should be able to do is configure what it is, and what it
does.  Thus, the next two commands to be implemented are `is` and `does`.

Bootstrapping the first object in the known universe is always a little
problematic, but in this case, it's not too bad, just a matter of calling a
couple of commands directly instead of calling them through the object name, as
all other objects will do.

======
}

namespace eval object {

    proc is {_ what} {
        if {![string match ::* $what]} {
            set what [uplevel 1 [list namespace which $what]]
        }
        set _path [namespace eval $_ {namespace path}]
        if {$what ni $_path} {
            namespace eval $_ [list namespace path [list $what {*}$_path]]
        }
        set map_orig [namespace ensemble configure $_ -map]
        set map_add [namespace ensemble configure $what -map]
        namespace ensemble configure $_ -map [dict merge $map_add $map_orig]
    }

    proc does {_ args} {
        if {[llength $args]} {
            set map [namespace ensemble configure $_ -map]
            foreach what $args {
                if {[llength $what] == 2} {
                    lassign what what target
                } else {
                    set target $what
                }
                dict set map $what [list ::apply [list {_ target args} {
                    tailcall $target $_ {*}$args
                } $_] $_ $target]
            }
            namespace ensemble configure $_ -map $map
        }
        dict keys [namespace ensemble configure $_ -map]
    }

    proc init {_ args} {}

    proc new {_ name} {
        set name [uplevel 1 [::list namespace eval $name {
            ::namespace ensemble create
            ::namespace current
        }]]
        set map {}
        foreach {cmd target} [namespace ensemble configure $_ -map] {
            set args [lassign $target apply function arg1]
            set function [lreplace $function 2 2 $name]
            set target [list $apply $function $name {*}$args]
            dict set map $cmd $target
        }
        namespace ensemble configure $name -map $map
        namespace eval $name [list namespace path [namespace eval $_ {namespace path}]]
        $name is $_
        $name does init
        $name init
        return $name
    }

    # bootstrap the system
    namespace ensemble create
    does [namespace current] is
    does [namespace current] does
    [namespace current] is [namespace current]
    [namespace current] does new
}

if 0 {
======

Let's make an command to make it more convenient to evaluate scripts in the
object namespace:

======
}

namespace eval object {
    proc eval {_ args} {
        ::tailcall namespace eval $_ [join $args]
    }
}
object does eval

if 0 {
======

Many object systems provide some way for an object command to call an object
command by the same name in an ancestor object.  Let's add one to the object.
The `\0` namespace is just used as an empty namespace separate from the normal
object, that can be configured with the path of the object in order to look up
the next command.  Since the path of an object may change dynamically, it's
best to grab that path and configure `\0' with it just before the lookup.

======
}
namespace eval object {
    proc upcall {_ args} {
        set current [uplevel 1 {namespace current}] 
        set path [namespace eval $_ {namespace path}]
        while {[set idx [lsearch -exact $path $current]] >= 0} {
            set path [lreplace $path $idx $idx]
        }
        namespace eval \0 [list namespace path $path]
        tailcall apply [list {_ cmd args} {
            tailcall $cmd $_ {*}$args
        } [namespace current]::\0] $_ {*}$args
    }
}
object does upcall


if 0 {
======
Now that the primordial object exists, it can be used to create another object
as the timer:
======
}

#rename timer {}
object new timer
timer does lap elapsed running start stop

if 0 {
======

Create a command to initialize the timer:

======
}


timer eval {
    proc init _  {
        namespace upvar $_ elapsed elapsed running running start start
        set elapsed [expr 0]
        set running [expr 0]
        set start [expr -1]
        return $_
    }
}


timer new timer1
timer1 start
after 2000
puts [timer1 elapsed]

if 0 {
======

To create a specialized timer, create a timer and then override the object
commands to as needed:

======
}

timer new vartimer
vartimer does faster slower

vartimer eval {
    proc init _ {
        namespace upvar $_ factor factor
        $_ upcall init
        set factor 1.0
    }
}

vartimer new timer2
timer2 faster
timer2 faster
timer2 start
after 2000
puts [timer2 elapsed]

if 0 {
======

That's it.  The object system presented on this page has a sufficient feature
set to use in real projects.  [ycl shelf] is built on many of these techniques,
and  features more bells and whistles.

======

<<categories>> object orientation
}