You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
183 lines
4.1 KiB
183 lines
4.1 KiB
# 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.45 2009/06/22 18:21:59 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.2
|
|
|