source: tol/tolsh/tolsh.vfs/lib/tcllib1.10/struct/tree.tcl @ 8597867d

# tree.tcl --
#
#       Implementation of a tree data structure for Tcl.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tree.tcl,v 1.44 2007/06/17 01:22:18 andreas_kupries Exp $

# @mdgen EXCLUDE: tree_c.tcl

package require Tcl 8.2
package require struct::list

namespace eval ::struct::tree {}

# ### ### ### ######### ######### #########
## Management of tree implementations.

# ::struct::tree::LoadAccelerator --
#
#       Loads a named implementation, if possible.
#
# Arguments:
#       key     Name of the implementation to load.
#
# Results:
#       A boolean flag. True if the implementation
#       was successfully loaded; and False otherwise.

proc ::struct::tree::LoadAccelerator {key} {
    variable accel
    set r 0
    switch -exact -- $key {
        critcl {
            # Critcl implementation of tree requires Tcl 8.4.
            if {![package vsatisfies [package provide Tcl] 8.4]} {return 0}
            if {[catch {package require tcllibc}]} {return 0}
            set r [llength [info commands ::struct::tree_critcl]]
        }
        tcl {
            variable selfdir
            source [file join $selfdir tree_tcl.tcl]
            set r 1
        }
        default {
            return -code error "invalid accelerator/impl. package $key:\
                must be one of [join [KnownImplementations] {, }]"
        }
    }
    set accel($key) $r
    return $r
}

# ::struct::tree::SwitchTo --
#
#       Activates a loaded named implementation.
#
# Arguments:
#       key     Name of the implementation to activate.
#
# Results:
#       None.

proc ::struct::tree::SwitchTo {key} {
    variable accel
    variable loaded

    if {[string equal $key $loaded]} {
        # No change, nothing to do.
        return
    } elseif {![string equal $key ""]} {
        # Validate the target implementation of the switch.

        if {![info exists accel($key)]} {
            return -code error "Unable to activate unknown implementation \"$key\""
        } elseif {![info exists accel($key)] || !$accel($key)} {
            return -code error "Unable to activate missing implementation \"$key\""
        }
    }

    # Deactivate the previous implementation, if there was any.

    if {![string equal $loaded ""]} {
        rename ::struct::tree        ::struct::tree_$loaded
        rename ::struct::tree::prune ::struct::tree::prune_$loaded
    }

    # Activate the new implementation, if there is any.

    if {![string equal $key ""]} {
        rename ::struct::tree_$key        ::struct::tree
        rename ::struct::tree::prune_$key ::struct::tree::prune
    }

    # Remember the active implementation, for deactivation by future
    # switches.

    set loaded $key
    return
}

# ::struct::tree::Implementations --
#
#       Determines which implementations are
#       present, i.e. loaded.
#
# Arguments:
#       None.
#
# Results:
#       A list of implementation keys.

proc ::struct::tree::Implementations {} {
    variable accel
    set res {}
    foreach n [array names accel] {
        if {!$accel($n)} continue
        lappend res $n
    }
    return $res
}

# ::struct::tree::KnownImplementations --
#
#       Determines which implementations are known
#       as possible implementations.
#
# Arguments:
#       None.
#
# Results:
#       A list of implementation keys. In the order
#       of preference, most prefered first.

proc ::struct::tree::KnownImplementations {} {
    return {critcl tcl}
}

proc ::struct::tree::Names {} {
    return {
        critcl {tcllibc based}
        tcl    {pure Tcl}
    }
}

# ### ### ### ######### ######### #########
## Initialization: Data structures.

namespace eval ::struct::tree {
    variable  selfdir [file dirname [info script]]
    variable  accel
    array set accel   {tcl 0 critcl 0}
    variable  loaded  {}
}

# ### ### ### ######### ######### #########
## Initialization: Choose an implementation,
## most prefered first. Loads only one of the
## possible implementations. And activates it.

namespace eval ::struct::tree {
    variable e
    foreach e [KnownImplementations] {
        if {[LoadAccelerator $e]} {
            SwitchTo $e
            break
        }
    }
    unset e
}

# ### ### ### ######### ######### #########
## Ready

namespace eval ::struct {
    # Export the constructor command.
    namespace export tree
}

package provide struct::tree 2.1.1