Tcl Source Code

Artifact 90b5370e42ca28ac63e2c2153e7c4f92c04931bb:

Attachment "map.tcl" to ticket [2489836fff] added by apnadkarni 2009-01-06 17:20:06.

---

# Requires Tcl 8.6

oo::class create Map {
    constructor {map} {
        my variable _map
        array set _map $map
    }

    method -get {args} {
        my variable _map

        if {[llength $args] == 0} {
            return [array get _map]
        }
        set args [lassign $args key]
        
        if {[info exists _map($key)]} {
            return $_map($key)
        }

        if {[llength $args] == 0} {
            set msg "Key '$key' does not exist in instance [self]"
            throw [list WOOF [self class] $msg] $msg
        } else {
            return [lindex $args 0]
        }
    }

    method -set args {
        my variable _map
        array set _map $args
    }

    method -exists {key args} {
        my variable _map
        if {[info exists _map($key)]} {
            if {[llength $args] > 0} {
                upvar [lindex $args 0] val
                set val $_map($key)
            }
            return true
        } else {
            return false
        }
    }

    method -unset {key} {
        my variable _map
        unset -nocomplain _map($key)
    }

    method -clear {{pat *}} {
        my variable _map
        array unset _map $pat
    }

    method unknown args {
        if {[llength $args] == 1} {
            my -get [lindex $args]
        } elseif {[llength $args] == 2} {
            my -set {*}$args
        } else {
            next {*}$args
        }
    }

    export -get -set -exists -unset -clear
    unexport unknown
}