Index: openacs-4/packages/acs-api-browser/tcl/acs-api-documentation-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-api-browser/tcl/acs-api-documentation-procs.tcl,v diff -u -N -r1.30.2.7 -r1.30.2.8 --- openacs-4/packages/acs-api-browser/tcl/acs-api-documentation-procs.tcl 7 Dec 2015 19:06:32 -0000 1.30.2.7 +++ openacs-4/packages/acs-api-browser/tcl/acs-api-documentation-procs.tcl 30 Dec 2015 12:54:34 -0000 1.30.2.8 @@ -347,6 +347,7 @@ -xql:boolean -label {-first_line_tag
\n" - + append out [util_wrap_list $command_line] + + set intro_out "" if { $script_p } { - append out [subst {" return $out } ad_proc api_proc_pretty_name { -link:boolean + -include_debug_controls:boolean + {-proc_type ""} -label proc } { @@ -651,25 +680,22 @@ if {![info exists label]} { set label $proc } - ns_log notice "api_proc_pretty_name link $link_p, label $label, proc $proc" if { $link_p } { - append out "$label" + append out [subst {$label}] } else { append out $label } - array set doc_elements [nsv_get api_proc_doc $proc] - if {$doc_elements(deprecated_p)} { - set deprecated ", decprecated" - } else { - set deprecated "" + set doc_elements [nsv_get api_proc_doc $proc] + set debug_html [expr {$include_debug_controls_p && [info commands ::xo::api] ne "" + ? [::xo::api debug_widget $proc] : ""}] + set hints {} + if {$proc_type ne ""} {lappend hints $proc_type} + if {[dict exists $doc_elements protection]} {lappend hints [dict get $doc_elements protection]} + if {[dict get $doc_elements deprecated_p]} {lappend hints deprecated} + if {[llength $hints] > 0} { + append out " ([join $hints {, }])" } - if { $doc_elements(public_p) } { - append out " (public$deprecated)" - } - if { $doc_elements(private_p) } { - append out " (private$deprecated)" - } - ns_log notice "... return $out" + append out $debug_html return $out } @@ -726,19 +752,16 @@ @param proc_name the name spec of the proc @return body of the specified prox } { - if {[regexp {^(.*) (inst)?proc (.*)$} $proc_name match obj prefix method]} { if {[regexp {^(.*) (.*)$} $obj match thread obj]} { - # the definition is located in a disconnected thread - return [$thread do ::Serializer methodSerialize $obj $method $prefix] + return [::xo::api get_method_source $thread $obj $prefix $method] } else { - # the definition is locally in the connection thread - return [::Serializer methodSerialize $obj $method $prefix] + return [::xo::api get_method_source "" $obj $prefix $method] } } elseif {[regexp {^([^ ]+)(Class|Object) (.*)$} $proc_name . thread kind obj]} { - return [$thread do $obj serialize] + return [::xo::api get_object_source $thread $obj] } elseif {[regexp {(Class|Object) (.*)$} $proc_name . kind obj]} { - return [$obj serialize] + return [::xo::api get_object_source "" $obj] } elseif {[info procs $proc_name] ne ""} { return [info body $proc_name] } elseif {[info procs ::nsf::procs::$proc_name] ne ""} { @@ -986,7 +1009,7 @@ @return boolean value } { set result 0 - catch {set result [::xotcl::api inscope $scope ::xotcl::Object isobject $proc_name]} + catch {set result [::xo::api inscope $scope ::xotcl::Object isobject $proc_name]} return $result } @@ -1011,8 +1034,8 @@ } { - if {[info commands ::xotcl::api] ne ""} { - set scope [::xotcl::api scope_from_proc_index $proc_name] + if {[info commands ::xo::api] ne ""} { + set scope [::xo::api scope_from_proc_index $proc_name] } else { set scope "" } @@ -1143,7 +1166,7 @@ # to api-doc pages. Perhaps we should hyperlink them to the Tcl man pages? # else and elseif are be treated as special cases later - if {[info commands ::xotcl::api] ne ""} { + if {[info commands ::xo::api] ne ""} { set XOTCL_KEYWORDS [list self my next] # Only command names are highlighted, otherwise we could add XOTcl method # names by [lsort -unique [concat [list self my next] .. @@ -1268,7 +1291,7 @@ append html [pretty_token keyword $proc_name] } elseif {[is_xotcl_object $scope $proc_name]} { - set url [::xotcl::api object_url \ + set url [::xo::api object_url \ -show_source 1 -show_methods 2 \ $scope $proc_name] append html "" \Defined in + append intro_out [subst {
Defined in $doc_elements(script)
}] } if { $doc_elements(deprecated_p) } { - append out "Deprecated." + append intro_out "Deprecated." if { $doc_elements(warn_p) } { - append out " Invoking this procedure generates a warning." + append intro_out " Invoking this procedure generates a warning." } - append out "
\n" + append intro_out "
\n" } - append out "
[lindex $doc_elements(main) 0]\n
\n" - set haveBlocks [expr { - [info exists doc_elements(param)] - || [llength $doc_elements(switches)] > 0 - || [llength $doc_elements(positionals)] > 0 - || [info exists doc_elements(option)] - || [info exists doc_elements(return)] - || [info exists doc_elements(error)] - || [info exists doc_elements(author)] - || [info exists doc_elements(creation-date)] - || [info exists doc_elements(change-log)] - || [info exists doc_elements(cvs-id)] - || [info exists doc_elements(see)] - }] + set main [lindex $doc_elements(main) 0] + if {$main ne ""} { + append intro_out "
[lindex $doc_elements(main) 0]\n
\n" + } + + # + # Make first a quick check, and if it fails, double check details + # + set haveBlocks [expr {[llength $doc_elements(switches)] > 0 + || [llength $doc_elements(positionals)] > 0}] + if {$haveBlocks == 0} { + foreach e {param option return error author creation-date change-log cvs-id see} { + if {[info exists doc_elements($e)] && $doc_elements($e) ne ""} { + set haveBlocks 1 + break + } + } + } + if {$haveBlocks} { - append out "
\n" + set blocks_out "
\n" + } else { + set blocks_out "" } - - if { $source_p } { if {[parameter::get_from_package_key \ -package_key acs-api-browser \ -parameter FancySourceFormattingP \ -default 1]} { - append out [subst {\n" if { [info exists doc_elements(param)] } { foreach param $doc_elements(param) { @@ -487,49 +506,49 @@ } if { [llength $doc_elements(switches)] > 0 } { - append out "
\n" + append blocks_out [::apidoc::format_common_elements doc_elements] + append blocks_out "- Switches:
- \n" } if { [llength $doc_elements(positionals)] > 0 } { - append out "
\n" + append blocks_out "
- Switches:
- \n" + append blocks_out "
\n" foreach switch $doc_elements(switches) { - append out "
- -$switch" + append blocks_out "
" if { [info exists params($switch)] } { - append out "- -$switch" if {"boolean" in $flags($switch)} { - append out " (boolean)" + append blocks_out " (boolean)" } if { [info exists default_values($switch)] && $default_values($switch) ne "" } { - append out " (defaults to
" + append blocks_out "\"[ns_quotehtml $default_values($switch)]\"
)" + append blocks_out " (defaults to\"[ns_quotehtml $default_values($switch)]\"
)" } if {"required" in $flags($switch)} { - append out " (required)" + append blocks_out " (required)" } else { - append out " (optional)" + append blocks_out " (optional)" } - append out "- $params($switch)
" + append blocks_out "- $params($switch)
" } } - append out "- Parameters:
- \n" + append blocks_out "
- Parameters:
- \n" foreach positional $doc_elements(positionals) { - append out "$positional" + append blocks_out "$positional" if { [info exists default_values($positional)] } { if { $default_values($positional) eq "" } { - append out " (optional)" + append blocks_out " (optional)" } else { - append out " (defaults to
\n" + append blocks_out "\n" } @@ -539,46 +558,47 @@ # by ad_proc. if { [info exists doc_elements(option)] } { - append out "Options:\"$default_values($positional)\"
)" + append blocks_out " (defaults to\"$default_values($positional)\"
)" } } if { [info exists params($positional)] } { - append out " - $params($positional)" + append blocks_out " - $params($positional)" } - append out "
\n" + append blocks_out "
\n" } - append out "" + append blocks_out "Options:
" } if { [info exists doc_elements(return)] } { - append out "" foreach param $doc_elements(option) { if { [regexp {^([^ \t]+)[ \t](.+)$} $param "" name value] } { - append out "
" + append blocks_out "- -$name
- $value
" + append blocks_out "- -$name
- $value
" } } - append out "- Returns:
- [join $doc_elements(return) "
\n" + append blocks_out "
"]- Returns:
- [join $doc_elements(return) "
\n" } if { [info exists doc_elements(error)] } { - append out "
"]- Error:
- [join $doc_elements(error) "
\n" + append blocks_out "
"]- Error:
- [join $doc_elements(error) "
\n" } - append out [::apidoc::format_common_elements doc_elements] - - append out "
"]Source code: + set source_out [subst { Source code: }] } else { - append out [subst { [::apidoc::tcl_to_html $proc_name]Source code: + set source_out [subst { Source code: }] } + } else { + set source_out "" } set xql_base_name $::acs::rootdir/ @@ -604,9 +624,10 @@ if { [file exists $::acs::rootdir/$xql_fn] } { set content [apidoc::get_xql_snippet -proc_name $proc_name -xql_file $xql_fn] if {$content ne ""} {set content " [ns_quotehtml [api_get_body $proc_name]]$content"} + set href [export_vars -base content-page-view {{source_p 1} {path $xql_fn}}] append there [subst {PostgreSQL XQL file: $content - $xql_fn + $xql_fn }] @@ -618,29 +639,37 @@ if { [file exists $::acs::rootdir/$xql_fn] } { set content [apidoc::get_xql_snippet -proc_name $proc_name -xql_file $xql_fn] if {$content ne ""} {set content "
$content"} + set href [export_vars -base content-page-view {{source_p 1} {path $xql_fn}}] append there [subst {Oracle XQL file: $content - $xql_fn + $xql_fn }] } else { lappend missing Oracle } if {[llength $missing] > 0} { - append out [subst {
XQL Not present: [join $missing ", "] }] + set xql_out [subst {XQL Not present: [join $missing ", "] }] } - append out $there + append xql_out $there + } else { + set xql_out "" } + set out_sections $intro_out$blocks_out$source_out$xql_out + if {$out_sections ne ""} { + append out$out_sections+ } # No "see also" yet. - append out "