summaryrefslogtreecommitdiffstats
path: root/testing/063_bug_729092.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'testing/063_bug_729092.tcl')
-rw-r--r--testing/063_bug_729092.tcl49
1 files changed, 49 insertions, 0 deletions
diff --git a/testing/063_bug_729092.tcl b/testing/063_bug_729092.tcl
new file mode 100644
index 0000000..7c35f95
--- /dev/null
+++ b/testing/063_bug_729092.tcl
@@ -0,0 +1,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
+ }
+} \ No newline at end of file