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