blob: 7c35f9509988b87da258a9fe83a0b1e338cb428b (
plain)
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
|
#// objective: test for bug 729092 - TCL: Full documentation not shown for procs in namespaces.
#// check: namespaceoo.xml
#// check: namespaceoo_1_1_helpers.xml
#// check: namespaceoo_1_1define.xml
#// config: EXTRACT_ALL = yes
#// config: GENERATE_HTML = yes
# taken from
# https://bugzilla.gnome.org/show_bug.cgi?id=729092
##
# Extension to TclOO to add static methods.
# Defines the method on the class instead of on the object. Can be used for
# the creation of megawidgets using TclOO by overriding the unknown method to
# detect if the user is trying to instantiate a widget (because the method
# will be unknown and start with a dot).
# @warning Do not modify! (unless you're waaay smarter than the writer of the
# below Tcl/Tk book).
# @cite flynt2012tcl
#
proc ::oo::define::classmethod {name {args ""} {body ""}} {
# Create the method on the class if the caller gave arguments and body.
if {[llength [info level 0]] == 4} {
uplevel 1 [list self method $name $args $body]
}
# Get the name of the class being defined.
set cls [lindex [info level -1] 1]
# Make connection to private class "my" command by forwarding.
uplevel forward $name [info object namespace $cls]::my $name
}
##
# Extension to TclOO to add static variables.
# Defines variables on the class instead of on the object. Can be used to
# enforce a limited number of instantiations.
# @warning Do not modify! (unless you're waaay smarter than the writer of the
# below Tcl/Tk book).
# @cite flynt2012tcl
#
proc ::oo::Helpers::classvar {args} {
# Get reference to class's namespace.
set nsCl [info object namespace [uplevel 1 {self class}]]
set nsObj [uplevel 1 {namespace current}]
# Link variables into local (caller's) scope.
foreach v $args {
uplevel "my variable $v"
upvar #0 ${nsCl}::$v ${nsObj}::$v
}
}
|
