1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
# ----------------------------------------------------------------------
# PURPOSE: Clear all class data and reload a class definition
#
# AUTHOR: Michael J. McLennan Phone: (610)712-2842
# AT&T Bell Laboratories E-mail: michael.mclennan@att.com
#
# RCS: itcl_reload.tcl,v 1.1.1.1 1994/03/21 22:09:46 mmc Exp
# ----------------------------------------------------------------------
# Copyright (c) 1993 AT&T Bell Laboratories
# ======================================================================
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that the copyright notice and warranty disclaimer appear in
# supporting documentation, and that the names of AT&T Bell Laboratories
# any of their entities not be used in advertising or publicity
# pertaining to distribution of the software without specific, written
# prior permission.
#
# AT&T disclaims all warranties with regard to this software, including
# all implied warranties of merchantability and fitness. In no event
# shall AT&T be liable for any special, indirect or consequential
# damages or any damages whatsoever resulting from loss of use, data or
# profits, whether in an action of contract, negligence or other
# tortuous action, arising out of or in connection with the use or
# performance of this software.
# ======================================================================
# ----------------------------------------------------------------------
# USAGE: itcl_unload <className>...
#
# Destroys all objects in the specified classes, and destroys the
# class definitions. Also destroys all objects and class definitions
# that inherit from the specified classes.
# ----------------------------------------------------------------------
proc itcl_unload {args} {
foreach class [eval itcl_dependencies $args] {
foreach o [itcl::find objects -class $class] {
itcl::delete object $o
}
itcl::delete class $class
}
foreach class $args {
foreach o [itcl::find objects -class $class] {
itcl::delete object $o
}
itcl::delete class $class
}
}
# ----------------------------------------------------------------------
# USAGE: itcl_reload <className>...
#
# Destroys all objects in the specified classes, and all objects
# that inherit from the specified classes. Destroys and re-loads
# the specified classes and any other classes that inherit from
# the specified classes. Useful during debugging to avoid having
# to restart the program to recognize source changes.
# ----------------------------------------------------------------------
proc itcl_reload {args} {
eval itcl_unload $args
#
# Reload specified classes and dependent classes.
# NOTE: Autoloading of class definitions is forced
# by invoking the class name with no arguments.
#
foreach class $args {
$class
}
foreach class [eval itcl_dependencies $args] {
$class
}
}
# ----------------------------------------------------------------------
# USAGE: itcl_dependencies <className>...
#
# Returns a list of classes that have the specified classes in their
# inheritance hierarchy. Each element in the return list will be
# a unique class name. Used in "itcl_unload" and "itcl_reload" to
# unload and reload derived classes whenever the base classes change.
# ----------------------------------------------------------------------
proc itcl_dependencies {args} {
set depends(x) make-this-an-array
unset depends(x)
set classes [itcl::find classes]
foreach class $args {
foreach dclass $classes {
if {$dclass != $class} {
set hier [$dclass::info heritage]
if {[lsearch $hier $class] >= 0} {
set depends($dclass) $class
}
}
}
}
return [array names depends]
}
|
