1# graph.tcl -- 2# 3# Implementation of a graph data structure for Tcl. 4# 5# Copyright (c) 2000-2005 by Andreas Kupries 6# 7# See the file "license.terms" for information on usage and redistribution 8# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 9# 10# RCS: @(#) $Id: graph.tcl,v 1.33 2009/09/24 16:23:47 andreas_kupries Exp $ 11 12# @mdgen EXCLUDE: graph_c.tcl 13 14package require Tcl 8.4 15 16namespace eval ::struct::graph {} 17 18# ### ### ### ######### ######### ######### 19## Management of graph implementations. 20 21# ::struct::graph::LoadAccelerator -- 22# 23# Loads a named implementation, if possible. 24# 25# Arguments: 26# key Name of the implementation to load. 27# 28# Results: 29# A boolean flag. True if the implementation 30# was successfully loaded; and False otherwise. 31 32proc ::struct::graph::LoadAccelerator {key} { 33 variable accel 34 set r 0 35 switch -exact -- $key { 36 critcl { 37 # Critcl implementation of graph requires Tcl 8.4. 38 if {![package vsatisfies [package provide Tcl] 8.4]} {return 0} 39 if {[catch {package require tcllibc}]} {return 0} 40 set r [llength [info commands ::struct::graph_critcl]] 41 } 42 tcl { 43 variable selfdir 44 source [file join $selfdir graph_tcl.tcl] 45 set r 1 46 } 47 default { 48 return -code error "invalid accelerator/impl. package $key:\ 49 must be one of [join [KnownImplementations] {, }]" 50 } 51 } 52 set accel($key) $r 53 return $r 54} 55 56# ::struct::graph::SwitchTo -- 57# 58# Activates a loaded named implementation. 59# 60# Arguments: 61# key Name of the implementation to activate. 62# 63# Results: 64# None. 65 66proc ::struct::graph::SwitchTo {key} { 67 variable accel 68 variable loaded 69 70 if {[string equal $key $loaded]} { 71 # No change, nothing to do. 72 return 73 } elseif {![string equal $key ""]} { 74 # Validate the target implementation of the switch. 75 76 if {![info exists accel($key)]} { 77 return -code error "Unable to activate unknown implementation \"$key\"" 78 } elseif {![info exists accel($key)] || !$accel($key)} { 79 return -code error "Unable to activate missing implementation \"$key\"" 80 } 81 } 82 83 # Deactivate the previous implementation, if there was any. 84 85 if {![string equal $loaded ""]} { 86 rename ::struct::graph ::struct::graph_$loaded 87 } 88 89 # Activate the new implementation, if there is any. 90 91 if {![string equal $key ""]} { 92 rename ::struct::graph_$key ::struct::graph 93 } 94 95 # Remember the active implementation, for deactivation by future 96 # switches. 97 98 set loaded $key 99 return 100} 101 102# ::struct::graph::Implementations -- 103# 104# Determines which implementations are 105# present, i.e. loaded. 106# 107# Arguments: 108# None. 109# 110# Results: 111# A list of implementation keys. 112 113proc ::struct::graph::Implementations {} { 114 variable accel 115 set res {} 116 foreach n [array names accel] { 117 if {!$accel($n)} continue 118 lappend res $n 119 } 120 return $res 121} 122 123# ::struct::graph::KnownImplementations -- 124# 125# Determines which implementations are known 126# as possible implementations. 127# 128# Arguments: 129# None. 130# 131# Results: 132# A list of implementation keys. In the order 133# of preference, most prefered first. 134 135proc ::struct::graph::KnownImplementations {} { 136 return {critcl tcl} 137} 138 139proc ::struct::graph::Names {} { 140 return { 141 critcl {tcllibc based} 142 tcl {pure Tcl} 143 } 144} 145 146# ### ### ### ######### ######### ######### 147## Initialization: Data structures. 148 149namespace eval ::struct::graph { 150 variable selfdir [file dirname [info script]] 151 variable accel 152 array set accel {tcl 0 critcl 0} 153 variable loaded {} 154} 155 156# ### ### ### ######### ######### ######### 157## Initialization: Choose an implementation, 158## most prefered first. Loads only one of the 159## possible implementations. And activates it. 160 161namespace eval ::struct::graph { 162 variable e 163 foreach e [KnownImplementations] { 164 if {[LoadAccelerator $e]} { 165 SwitchTo $e 166 break 167 } 168 } 169 unset e 170} 171 172# ### ### ### ######### ######### ######### 173## Ready 174 175namespace eval ::struct { 176 # Export the constructor command. 177 namespace export graph 178} 179 180package provide struct::graph 2.4 181