Artifact dcf5de92000e51eccbbf462dda7fa525f5c6a5ef:

• File packages/ns/lib/facade.tcl — part of check-in [f7b5aa6901] at 2020-08-09 15:14:04 on branch trunk — ns rename [public] to [facade] (user: pooryorick size: 1925)

#! /usr/bin/env tclsh

namespace eval interface {
	package require {ycl proc}
	[yclprefix] proc alias aliases [yclprefix] proc aliases
	aliases {
		{ycl eval} {
			call
			upcall
		}
		{ycl ns} {
			ensemble
			nsjoin join
			object
			which
		}
		{ycl proc} {
			alias
			import
			imports
			lambda
		}
	}

	proc .new {name object} {
		set ns [call 1 $object .nsgen]
		namespace eval $ns {
			namespace export *
		}
		set ins [namespace eval [nsjoin $ns internal] {namespace current}]
		set interface [namespace eval [nsjoin $ns interface] {
			namespace current}]
		set objref [upcall 1 import [nsjoin $ins object] $object]
		alias [nsjoin $interface facade] [nsjoin [namespace parent] system facade] $ns
		call 1 $object .extend $interface
		set ensemble [upcall 1 ensemble create $ns $name]
		upcall 1 import [nsjoin $ins facade] $ensemble
		trace add command $ensemble delete [lambda {objref oldname newname op} {
			set origin [namespace origin $objref]
			rename $origin {}
	 	} $objref]
		return $ensemble
	}

	imports [namespace parent] [namespace current] {
		.new
	}
}
namespace eval public {}
namespace eval system {
	namespace eval facade {
		namespace ensemble create -prefixes 0 -parameters {facade _}
		namespace export *
	}

	namespace eval internal {
		package require {ycl proc}
		[yclprefix] proc alias aliases [yclprefix] proc aliases
		aliases {
			{ycl ns} {
				nsjoin join
			}
			{ycl proc} {
				alias
				imports
			}
		}


		proc add {facade _ routine} {
			set name [nsjoin $facade $routine]
			alias $name [nsjoin $facade internal object] $routine
		}


		proc name {facade _} {
			namespace origin [nsjoin $facade internal facade]
		}


		proc remove {facade _ routine} {
			set name [nsjoin $facade $routine]
			if {[namespace which $name] ne {}} {
				rename $name {}
			}
			return
		}


		imports [nsjoin [namespace parent] facade] [namespace current] {
			add
			name
			remove
		}
	}
}