Index: openacs-4/packages/xotcl-core/www/show-object.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/www/show-object.tcl,v
diff -u -r1.15.6.4 -r1.15.6.5
--- openacs-4/packages/xotcl-core/www/show-object.tcl 17 Sep 2013 19:28:10 -0000 1.15.6.4
+++ openacs-4/packages/xotcl-core/www/show-object.tcl 24 Sep 2013 20:17:46 -0000 1.15.6.5
@@ -18,12 +18,19 @@
set output ""
::xotcl::api scope_from_object_reference scope object
+#
+# scope must be an object, otherwise something is wrong.
+#
if {$scope ne "" && ![xo::getObjectProperty $scope isobject]} {
set isobject 0
} else {
set isobject [::xotcl::api isobject $scope $object]
}
+if {$scope ne ""} {
+ auth::require_login
+}
+
if {!$isobject} {
ad_return_complaint 1 "Unable to access object $object.
Might this be a temporary object?"
@@ -85,9 +92,8 @@
proc info_option {scope object kind {dosort 0}} {
upvar class_references class_references
- set isnx [xo::getObjectProperty $object isnxobject]
+ set isnx [DO xo::getObjectProperty $object isnxobject]
set list [DO xo::getObjectProperty $object $kind]
- set list [DO xo::getObjectProperty $object $kind]
if {$dosort} {set list [lsort $list]}
@@ -117,8 +123,8 @@
proc class_summary {c scope} {
set result ""
- set parameters [lsort [xo::getObjectProperty $c parameter]]
- append result "
Meta-class: [::xotcl::api object_link $scope [xo::getObjectProperty $c class]]\n"
+ set parameters [lsort [DO xo::getObjectProperty $c parameter]]
+ append result "Meta-class: [::xotcl::api object_link $scope [DO xo::getObjectProperty $c class]]\n"
if {$parameters ne ""} {
set pretty [list]
foreach p $parameters {
@@ -132,7 +138,7 @@
}
append result "Parameter for instances: [join $pretty {, }]\n"
}
- set methods [lsort [xo::getObjectProperty $c instcommand]]
+ set methods [lsort [DO xo::getObjectProperty $c instcommand]]
set pretty [list]
foreach m $methods {
if {[info exists param($m)]} continue
@@ -142,10 +148,10 @@
if {[llength $pretty]>0} {
append result "Methods for instances: [join $pretty {, }]"
}
- set methods [lsort [xo::getObjectProperty $c command]]
+ set methods [lsort [DO xo::getObjectProperty $c command]]
set pretty [list]
foreach m $methods {
- if {![::xotcl::Object isobject ${c}::$m]} {
+ if {![DO ::xotcl::Object isobject ${c}::$m]} {
lappend pretty [::xotcl::api method_link $c proc $m]
}
}
@@ -170,7 +176,7 @@
}
proc superclass_hierarchy {cl scope} {
set l [list]
- foreach c [reverse [concat $cl [$cl info heritage]]] {
+ foreach c [reverse [concat $cl [DO $cl info heritage]]] {
lappend s [class_summary $c $scope]
}
return $s
@@ -190,12 +196,12 @@
#
# compute list of classes with siblings
set class_hierarchy [list]
- foreach c [$object info superclass] {
+ foreach c [DO $object info superclass] {
if {$c eq "::xotcl::Object"} {continue}
- lappend class_hierarchy {*}[$c info subclass]
+ lappend class_hierarchy {*}[DO $c info subclass]
}
if {[llength $class_hierarchy]>5} {set class_hierarchy {}}
- eval lappend class_hierarchy [$object info heritage]
+ lappend class_hierarchy {*}[DO $object info heritage]
if {$object ni $class_hierarchy} {lappend class_hierarchy $object}
#::xotcl::Object msg class_hierarchy=$class_hierarchy
set class_hierarchy [ns_urlencode $class_hierarchy]