tree.tcl

Go to the documentation of this file.

/*  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 ::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.*/

ret  ::struct::tree::LoadAccelerator (type 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.*/

ret  ::struct::tree::SwitchTo (type 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.*/

ret  ::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.*/

ret  ::struct::tree::KnownImplementations () {
    return {critcl tcl}
}

ret  ::struct::tree::Names () {
    return {
    critcl {tcllibc based}
    tcl    {pure Tcl}
    }
}

/*  ### ### ### ######### ######### #########*/
/*  Initialization: Data structures.*/

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

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

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

/*  ### ### ### ######### ######### #########*/
/*  Ready*/

namespace ::struct {
    /*  Export the constructor command.*/
    namespace export tree
}

package provide struct::tree 2.1.1