1# component.tcl -- 2# 3# Provides a structure for code components. 4# 5# This file is distributed under BSD style license. 6# 7# $Id: component.tcl,v 1.10 2008-05-13 09:13:00 matben Exp $ 8 9package provide component 1.0 10 11namespace eval component { 12 13 # Search path for components, similar to ::auto_path. 14 variable auto_path [list] 15 16 variable priv 17 set priv(offL) [list] 18} 19 20proc component::lappend_auto_path {path} { 21 variable auto_path 22 lappend auto_path $path 23} 24 25# component::exclude -- 26# 27# Set list of component names we shall not attempt to load. 28 29proc component::exclude {offL} { 30 variable priv 31 set priv(offL) $offL 32} 33 34# component::attempt -- 35# 36# Used in cmpntIndex files. 37 38proc component::attempt {name fileName initProc} { 39 variable priv 40 41 # This normally calls 'component::define'. 42 uplevel #0 [list source $fileName] 43 44 if {[info exists priv($name,name)]} { 45 if {[lsearch $priv(offL) $name] < 0} { 46 47 # While 'component::register' may get called here. 48 uplevel #0 $initProc 49 } 50 } 51} 52 53# component::define -- 54# 55# Each component defines itself with name and string. 56# It doesn't load anything. 57 58proc component::define {name str} { 59 variable priv 60 set priv($name,name) $name 61 set priv($name,str) $str 62} 63 64proc component::undefine {name} { 65 variable priv 66 array unset priv $name,* 67} 68 69# component::register -- 70# 71# Each component register with this function which means it is 72# being loaded. 73 74proc component::register {name} { 75 variable priv 76 set priv($name,reg) 1 77} 78 79proc component::unregister {name} { 80 variable priv 81 82 # This is an incomplete way of removing a component. 83 array unset priv $name,* 84} 85 86proc component::getall {} { 87 variable priv 88 89 set ans [list] 90 foreach {key value} [array get priv *,name] { 91 set name $priv($key) 92 lappend ans [list $name $priv($name,str)] 93 } 94 return [lsort -index 0 $ans] 95} 96 97# component::load -- 98# 99# Loads all cmpntIndex.tcl files. 100# Each line in the cmpntIndex.tcl file defines a component to be loaded: 101# 102# component::attempt MyCool [file join $dir mycool.tcl] MyCoolInitProc 103 104proc component::load {} { 105 variable auto_path 106 foreach dir $auto_path { 107 loaddir $dir 108 } 109} 110 111proc component::loaddir {dir} { 112 113 # 'dir' must be defined! 114 set f [file join $dir cmpntIndex.tcl] 115 if {[file exists $f]} { 116 source $f 117 } 118 119 # Search dirs recursively. 120 foreach d [glob -directory $dir -nocomplain *] { 121 if {[file isdirectory $d]} { 122 loaddir $d 123 } 124 } 125} 126 127proc component::exists {name} { 128 variable priv 129 return [info exists priv($name,reg)] 130} 131 132#------------------------------------------------------------------------------- 133