debug_widget (scripted)
if {![acs_user::site_wide_admin_p]
|| [info commands ::nsf::method::property] eq ""
|| $::nsf::version < 2.1
} {
return ""
}
switch [llength $proc_spec] {
1 {lassign [list "" ::nx::Object nsfproc $proc_spec] scope obj methodType method
if {![string match ::* $method]} {
set method ::$method
}
if {[nsf::cmd::info type $method] ne "nsfproc"} {
return ""
}
}
3 {lassign $proc_spec obj methodType method; set scope ""}
4 {lassign $proc_spec scope obj methodType method}
default {
ns_log notice "[self] debug_widget: Unexpected format <$proc_spec> consists of [llength $proc_spec] parts"
return ""
}
}
if {$methodType eq "proc"} {
set modifier "-per-object"
} elseif {$methodType in {instproc nsfproc}} {
set modifier ""
} elseif {$methodType eq "Class"} {
return ""
} else {
ns_log warning "[self] debug_widget unexpected method type <$methodType>"
set modifier ""
}
set isObject [:scope_eval $scope ::nsf::is object $obj]
if {!$isObject} {
return ""
}
set debug_p [:scope_eval $scope ::nsf::method::property $obj {*}$modifier $method debug]
set form_id "form-[incr ::__form_id]"
if {$::__form_id eq "1"} {
template::add_body_script -script {
function ajax_submit(form) {
var xhr = new XMLHttpRequest();
xhr.open('POST', '/xotcl/admin/toggle-debug', true);
xhr.onreadystatechange = function() {
if (this.readyState == 4) {
if (this.status != 200) {
alert('AJAX submit unexpected response: ' + this.status);
}
}
}
xhr.send(new FormData(form));
};
}
}
template::head::add_css -href "/resources/xotcl-core/titatoggle/titatoggle-dist.css"
if {$debug_p} {set state checked} {set state ""}
set html [subst {
<form id="$form_id" class="form" method="POST" action="/xotcl/admin/toggle-debug">
<div class="checkbox checkbox-slider--b-flat">
<label class="checkbox-inline">
<input class="debug form-control" id="$form_id-control" name="debug" type="checkbox" $state><span>Debug</span>
<input name="proc_spec" type="hidden" value="$proc_spec">
<input name="return_url" type="hidden" value="[ns_quotehtml [ad_return_url]]">
</label>
</div>
</form>
}]
template::add_body_script -script [subst {
document.getElementById('$form_id-control').addEventListener('click', function (event) {
ajax_submit(this.form);
});
}]
return $html
get_doc_block (scripted)
set lines [split $text \n]
set docBlock ""
set i 0
set nrLines [llength $lines]
while {[string is space [lindex $lines $i]] && $i < $nrLines} {incr i}
while {$i < $nrLines} {
set line [string trim [lindex $lines $i]]
incr i
if {[string index $line 0] ne "#"} break
append docBlock [string range $line 1 end] \n
}
if {$restVar ne ""} {
upvar $restVar rest
set rest [join [lrange $lines $i-1 end] \n]
}
return $docBlock
get_init_block (scripted)
if {[:scope_eval $scope ::nsf::var::exists $obj __cmd(__initblock)]} {
return [:scope_eval $scope ::nsf::var::set $obj __cmd(__initblock)]
}
return ""
get_method_body (scripted)
:scope_eval $scope ::nsf::dispatch $obj ::nsf::methods::[expr {$prefix eq "inst" ? "class" : "object"}]::info::method body $method
get_method_source (scripted)
:scope_eval $scope ::Serializer methodSerialize $obj $method $prefix
get_object_source (scripted)
if {![nsf::is object $obj]} {
ns_log warning "[self] get_object_source: argument passed as obj is not an object: $obj"
return ""
}
set init_block [:get_init_block $scope $obj]
if {$init_block ne ""} {
set dummy [:get_doc_block $init_block body]
return $body
} else {
return [:scope_eval $scope $obj serialize]
}
get_proc_definition_flags (scripted)
if {$::nsf::version < 2.1} {
return ""
}
return [list -debug=$debug -deprecated=$deprecated]
get_returns_spec (scripted)
if {$::nsf::version < 2.1} {
set result ""
} elseif {$returns ne ""} {
set result [list -returns $returns]
} else {
set result ""
}
return $result
isclass (scripted)
:scope_eval $scope xo::getObjectProperty $obj isclass
isobject (scripted)
:scope_eval $scope xo::getObjectProperty $obj isobject
method_label (scripted)
switch [llength $proc_spec] {
1 {}
3 {lassign $proc_spec obj methodType method; set scope ""}
4 {lassign $proc_spec scope obj methodType method}
default {
ns_log notice "Unexpected format <$proc_spec> consists of [llength $proc_spec] parts"
}
}
if {[info exists method]} {
set isObject [:scope_eval $scope ::nsf::is object $obj]
if {$isObject} {
set isNx [:scope_eval $scope ::nsf::directdispatch $obj ::nsf::methods::object::info::hastype ::nx::Class]
if {$kind} {
set result [set :methodLabel($isNx-$methodType)]
} else {
set result "$obj [set :methodLabel($isNx-$methodType)] $method"
}
return $result
}
}
return $proc_spec
method_link (scripted)
set kind [string trimright $kind s]
set proc_index [::xo::api proc_index "" $obj $kind $method]
if {[nsv_exists api_proc_doc $proc_index]} {
return "<a href='/api-doc/proc-view?proc=[ns_urlencode $proc_index]'>$method</a>"
} else {
if {[::xo::getObjectProperty $obj $kind $method] eq ""} {
return $method<SUP>C</SUP>
} else {
return $method
}
}
object_index (scripted)
set kind [expr {[:isclass $scope $obj] ? "Class" : "Object"}]
return "$scope $kind $obj"
object_link (scripted)
set link "<a href='[ns_quotehtml [:object_url $scope $obj]]'>"
if {$noimg} {
return "$link$obj</a>"
} else {
return "$obj$link<img src='/resources/acs-subsite/ZoomIn16.gif' alt='\[i\]' border='0'></a>"
}
object_url (scripted)
set isObject [:scope_eval $scope ::nsf::is object $obj]
if {$isObject} {
set object [:scope_eval $scope namespace origin $obj]
return [export_vars -base /xotcl/show-object {object show_source show_methods}]
} else {
return .
}
proc_index (scripted)
if {$scope eq ""} {
return [list [string trimleft $obj :] $instproc $proc_name]
} else {
return [list $scope $obj $instproc $proc_name]
}
scope (scripted)
if {[info exists ::xotcl::currentThread]} {
return $::xotcl::currentThread
}
return ""
scope_eval (scripted)
if {$scope eq ""} {
{*}$args
} else {
$scope do {*}$args
}
scope_from_object_reference (scripted)
upvar $scope_var scope $object_var object
set scope ""
regexp {^(.+) do (.+)$} $object match scope object
scope_from_proc_index (scripted)
set scope ""
regexp {^(.+) .+ (inst)?proc (.+)$} $proc_index match scope
return $scope
script_name (scripted)
set script [info script]
if {$script eq "" && [info exists ::xotcl::currentScript]} {
set script $::xotcl::currentScript
}
set root_dir $::acs::rootdir
set root_length [string length $root_dir]
if { $root_dir eq [string range $script 0 $root_length-1]} {
set script [string range $script $root_length+1 end]
}
return $script
source_to_html (scripted)
set lines [list]
foreach l [split $string \n] {
while {[string length $l] > $width} {
set pos [string last " \{" $l $width]
if {$pos>10} {
lappend lines "[string range $l 0 $pos-1] \\"
set l " [string range $l $pos end]"
} else {
set pos [string first " \{" $l $width]
if {$pos > 10} {
lappend lines "[string range $l 0 $pos-1] \\"
set l " [string range $l $pos end]"
} else {
set pos [string last " " $l $width]
if {$pos > 10} {
lappend lines "[string range $l 0 $pos-1] \\"
set l " [string range $l $pos end]"
} else {
break
}
}
}
}
lappend lines $l
}
set string [join $lines \n]
set html [ns_quotehtml $string]
regsub -all -- {(\n[\t ]*)(\#[^\n]*)} $html \\1<it>\\2</it> html
return "<pre class='code'>$html</pre>"
update_method_doc (scripted)
set methodType [::xo::getObjectProperty $obj ${inst}methodtype $proc_name]
set varargs_p [expr {$methodType eq "scripted"
&& "args" in [::xo::getObjectProperty $obj ${inst}args $proc_name]}]
set doc [dict create param "" protection $protection varargs_p $varargs_p deprecated_p $deprecated warn_p false script [::xo::api script_name $scope] main "" flags "" switches0 "" switches1 "" ]
if {$docString ne ""} {
ad_parse_documentation_string $docString doc_elements
set doc [dict replace $doc {*}[array get doc_elements]]
}
if {$methodType ne "scripted"} {
dict set doc default_values {}
dict set doc positionals {}
} else {
set defaults [list]
foreach a [::xo::getObjectProperty $obj ${inst}args $proc_name] {
if {[::xo::getObjectProperty $obj ${inst}argdefault $proc_name $a d]} {
lappend defaults $a $d
}
}
foreach def [::xo::getObjectProperty $obj ${inst}methodparameter $proc_name] {
lassign $def f default
set pair [split [lindex $f 0 0] :]
lassign $pair flaggedName flags
if {[string index $flaggedName 0] eq "-"} {
set isFlag 1
set name [string range $flaggedName 1 end]
} else {
set isFlag 0
set name $flaggedName
}
if {$isFlag} {
dict lappend doc switches0 $name
dict lappend doc flags $name $flags
if {$flags eq "switch" && $default eq ""} {
set default "false"
}
}
if {[llength $def] > 1} {
lappend defaults $name $default
}
}
dict set doc default_values $defaults
dict set doc positionals [::xo::getObjectProperty $obj ${inst}args $proc_name]
}
set proc_index [::xo::api proc_index $scope $obj ${inst}proc $proc_name]
if {![nsv_exists api_proc_doc $proc_index]} {
nsv_lappend api_proc_doc_scripts [dict get $doc script] $proc_index
}
nsv_set api_proc_doc $proc_index $doc
update_nx_docs (scripted)
if {[llength $objects] == 0} {
set objects [nx::Object info instances -closure]
}
foreach o $objects {
if {[string match ::nx::* $o]} continue
::xo::api update_object_doc "" $o ""
}
update_object_doc (scripted)
if {$doc_string eq ""} {
set doc_string [:get_doc_block [:get_init_block $scope $obj]]
}
ad_parse_documentation_string $doc_string doc_elements
set doc [dict create param "" protection public varargs_p false deprecated_p false warn_p false script [::xo::api script_name $scope] ]
set doc [dict replace $doc {*}[array get doc_elements]]
set switches {}; set flags {}
foreach l [dict get $doc param] {
if {[regexp {^([^ ]+)\s} $l . word]} {
lappend switches $word
lappend flags $word ""
}
}
set proc_index [::xo::api object_index $scope $obj]
set doc [dict replace $doc default_values "" switches0 $switches switches1 "" positionals "" flags $flags ]
if {![nsv_exists api_proc_doc $proc_index]} {
nsv_lappend api_proc_doc_scripts [dict get $doc script] $proc_index
}
nsv_set api_proc_doc $proc_index $doc
nsv_set api_library_doc $proc_index $doc
set file_index [dict get $doc script]
if {[nsv_exists api_library_doc $file_index]} {
array set elements [nsv_get api_library_doc $file_index]
}
set oldDoc [expr {[info exists elements(main)] ? [lindex $elements(main) 0] : ""}]
set prefix "This file defines the following Objects and Classes"
set entry [::xo::api object_link $scope $obj]
if {![string match "*$prefix*" $oldDoc]} {
append oldDoc "<p>$prefix: $entry"
} else {
append oldDoc ", $entry"
}
set elements(main) [list $oldDoc]
nsv_set api_library_doc $file_index [array get elements]
if {[::nsf::dispatch $obj ::nsf::methods::object::info::hastype ::nx::Class]} {
foreach protection {public protected private} {
foreach m [::nsf::dispatch $obj ::nsf::methods::class::info::methods -path -callprotection $protection -type scripted] {
set docBlock [:get_doc_block [::nsf::dispatch $obj ::nsf::methods::class::info::method body $m]]
::xo::api update_method_doc -protection $protection -deprecated=false -debug=false $scope $obj inst $m $docBlock
}
}
}
if {[::nsf::dispatch $obj ::nsf::methods::object::info::hastype ::nx::Object]} {
foreach protection {public protected private} {
foreach m [::nsf::dispatch $obj ::nsf::methods::object::info::methods -callprotection $protection -type scripted] {
set docBlock [:get_doc_block [::nsf::dispatch $obj ::nsf::methods::object::info::method body $m]]
::xo::api update_method_doc -protection $protection -deprecated=false -debug=false $scope $obj "" $m $docBlock
}
}
}