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 -r1.30 -r1.31 --- openacs-4/packages/acs-api-browser/tcl/acs-api-documentation-procs.tcl 19 Jun 2015 19:49:02 -0000 1.30 +++ openacs-4/packages/acs-api-browser/tcl/acs-api-documentation-procs.tcl 7 Aug 2017 23:47:45 -0000 1.31 @@ -16,9 +16,13 @@ # NaviServer at sourceforge # set ns_api_host "http://naviserver.sourceforge.net/" - set ns_api_index "n/naviserver/files/" - set ns_api_root ${ns_api_host}${ns_api_index} - set ns_api_html_index $ns_api_root/commandlist.html + set ns_api_index [list "n/naviserver/files/" "n/"] + set ns_api_root [list \ + ${ns_api_host}[lindex $ns_api_index 0] \ + ${ns_api_host}[lindex $ns_api_index 1] ] + set ns_api_html_index [list \ + [lindex $ns_api_root 0]commandlist.html \ + [lindex $ns_api_root 1]toc.html ] } else { # # AOLserver wiki on panpotic @@ -105,7 +109,7 @@ regsub -all {\#.*$} $line "" line set line [string trim $line] if { $line ne "" } { - set has_contract_p [regexp {(^ad_page_contract\s)|( initialize )} $line match] + set has_contract_p [regexp {(^ad_(page|include)_contract\s)|(Package initialize )} $line] break } } @@ -128,7 +132,7 @@ if {[regexp {^ad_page_contract documentation} $::errorInfo] } { array set doc_elements $error } - if { [info exists doc_elements] } { + if { [array exists doc_elements] } { return [array get doc_elements] } return [list] @@ -347,6 +351,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 } { @@ -648,22 +685,21 @@ set label $proc } if { $link_p } { - append out "$label" + append out [subst {$label}] } else { - append out "$label" + 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)" - } + append out $debug_html return $out } @@ -716,27 +752,29 @@ ad_proc -public api_get_body {proc_name} { - This function returns the body of a tcl proc or an xotcl method. + This function returns the body of a Tcl proc or an xotcl method. @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 {[info commands ::xo::api] ne "" + && [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 match thread kind obj]} { - return [$thread do $obj serialize] + } elseif {[info commands ::xo::api] ne "" + && [regexp {^([^ ]+) (Class|Object) (.*)$} $proc_name . thread kind obj]} { + return [::xo::api get_object_source $thread $obj] + } elseif {[info commands ::xo::api] ne "" + && [regexp {(Class|Object) (.*)$} $proc_name . kind obj]} { + 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 ""} { return [::nx::Object info method body ::nsf::procs::$proc_name] } else { - return "No such Tcl-proc" + return "No such Tcl-proc '$proc_name'" } } @@ -764,26 +802,42 @@ } ad_proc -public format_see { see } { - regsub -all {proc *} $see {} see + Takes the value in the argument "see" and possibly formats it + into a link that will give the user more info about that + resource + + @param see a string expected to comtain the resource to format + @return the html string representing the resource + } { + #regsub -all {proc *} $see {} see set see [string trim $see] if {[nsv_exists api_proc_doc $see]} { - return "$see" + set href [export_vars -base /api-doc/proc-view {{proc $see}}] + return [subst {$see}] } - if {[string match "/doc/*.html" $see] + if {[string match "/doc/*" $see] || [util_url_valid_p $see]} { - return "$see" + return [subst {$see}] } if {[file exists "$::acs::rootdir${see}"]} { - return "$see" + set href [export_vars -base content-page-view {{source_p 1} {path $see}}] + return [subst {$see}] } return ${see} } ad_proc -public format_author { author_string } { + + Extracts information about the author and formats it into an + HTML string. + + @param author_string author information to format + @return the formatted result + } { if { [regexp {^[^ \n\r\t]+$} $author_string] && [string first "@" $author_string] >= 0 && [string first ":" $author_string] < 0 } { - return "$author_string" + return [subst {$author_string}] } elseif { [regexp {^([^\(\)]+)\s+\((.+)\)$} [string trim $author_string] {} name email] } { return "$name <$email>" } @@ -956,13 +1010,13 @@ return $score } - ad_proc -private is_xotcl_object {scope proc_name} { + ad_proc -private is_object {scope proc_name} { Checks, whether the specified argument is an xotcl object. Does not cause problems when xocl is not loaded. @return boolean value } { set result 0 - catch {set result [::xotcl::api inscope $scope ::xotcl::Object isobject $proc_name]} + catch {set result [::xo::api isobject $scope $proc_name]} return $result } @@ -971,24 +1025,24 @@ Given a proc name, formats it as HTML, including highlighting syntax in various colors and creating hyperlinks to other proc definitions.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) { @@ -483,49 +510,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" } @@ -535,46 +562,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/ @@ -600,9 +628,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 }] @@ -614,29 +643,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 "
+
Known Issues: -