[api_quote_file ${xql_base_name}.xql]$content"} + append there [subst {
$content + $xql_fn +
}] } else { lappend missing Generic } - if { [file exists ${xql_base_name}-postgresql.xql] } { - append there [subst {
[api_quote_file ${xql_base_name}-postgresql.xql]$content"} + append there [subst {
$content + $xql_fn +
}] } else { lappend missing PostgreSQL } - if { [file exists ${xql_base_name}-oracle.xql] } { + set xql_fn [file rootname $doc_elements(script)]-oracle.xql + + 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"} append there [subst {
[api_quote_file ${xql_base_name}-oracle.xql]$content + $xql_fn +
}] } else { @@ -710,6 +712,26 @@ namespace eval ::apidoc { + ad_proc -private get_xql_snippet {-proc_name -xql_file} { + @return matching xql snippet for specified proc_name + } { + set content [template::util::read_file $::acs::rootdir/$xql_file] + + # make parsable XML, replace "partialquery" by "fullquery" + set prepared_content [db_qd_internal_prepare_queryfile_content $content] + + dom parse -simple $prepared_content doc + $doc documentElement root + set result "" + foreach q [$root selectNodes //fullquery] { + if {[string match "$proc_name.*" [$q getAttribute name]]} { + append result [$q asXML -indent 4] \n + } + } + set readable_xml [string map {< < > > & &} [string trimright $result]] + return [ns_quotehtml $readable_xml] + } + ad_proc -private api_format_see { see } { regsub -all {proc *} $see {} see set see [string trim $see] @@ -1061,6 +1083,7 @@ } { + set script [string trimright $script] template::head::add_style -style $apidoc::style # Keywords will be colored as other procs, but not hyperlinked @@ -1181,7 +1204,8 @@ && $had_colons in $::apidoc::KEYWORDS)} { set url "/api-doc/proc-view?proc=$proc_name" - append html "" [pretty_token keyword $proc_name] + append html "" \ + [pretty_token keyword $proc_name] #append html [pretty_token keyword $proc_name] @@ -1192,22 +1216,26 @@ set url [::xotcl::api object_url \ -show_source 1 -show_methods 2 \ $scope $proc_name] - append html "" [pretty_token object $proc_name] + append html "" \ + [pretty_token object $proc_name] } elseif {[string match "ns*" $proc_name]} { set url "/api-doc/tcl-proc-view?tcl_proc=$proc_name" - append html "" [pretty_token proc $proc_name] + append html "" \ + [pretty_token proc $proc_name] } elseif {[string match "*__arg_parser" $proc_name]} { append html [pretty_token helper $proc_name] } elseif {[info commands ::${proc_namespace}::${proc_name}] ne ""} { set url [api_proc_url ${proc_namespace}::${proc_name}] - append html "" [pretty_token proc $proc_name] + append html "" \ + [pretty_token proc $proc_name] } elseif {[info commands ::$proc_name] ne ""} { set url [api_proc_url $proc_name] - append html "" [pretty_token proc $proc_name] + append html "" \ + [pretty_token proc $proc_name] } else { append html ${proc_name} @@ -1222,7 +1250,7 @@ set regexpl [length_regexp [string range $data $i end]] append html [string range $data $i+1 $i+$regexpl] incr i $regexpl - } elseif {$proc_name eq "util_memoize"} { + } elseif {$proc_name in {util_memoize util_memoize_seed}} { # # special cases for util_memoize # @@ -1300,7 +1328,7 @@ @author Lars Pind (lars@pinds.com) @creation-date 14 July 2000 } { - return "/api-doc/proc-view?proc=[ns_urlencode [string trimleft $proc :]]" + return "/api-doc/proc-view?proc=[ns_urlencode $proc]&source_p=1" } ad_proc api_proc_link { proc } { Index: openacs-4/packages/acs-api-browser/www/proc-view.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-api-browser/www/proc-view.tcl,v diff -u -r1.6.16.7 -r1.6.16.8 --- openacs-4/packages/acs-api-browser/www/proc-view.tcl 5 Sep 2014 10:22:40 -0000 1.6.16.7 +++ openacs-4/packages/acs-api-browser/www/proc-view.tcl 9 Sep 2014 07:42:38 -0000 1.6.16.8 @@ -22,11 +22,12 @@ if { $version_id ne "" } { db_0or1row package_info_from_package_id { select pretty_name, package_key, version_name - from apm_package_version_info - where version_id = :version_id + from apm_package_version_info + where version_id = :version_id } if {[info exists package_id]} { - lappend context [list "package-view?version_id=$version_id&kind=procs" "$pretty_name $version_name"] + lappend context [list "package-view?version_id=$version_id&kind=procs" \ + "$pretty_name $version_name"] } } lappend context [list $proc] @@ -39,69 +40,97 @@ set source_p $default_source_p } -# Try and be helpful about the procedure. -if { ![nsv_exists api_proc_doc $proc] } { - if {[info procs ::$proc] eq "::$proc"} { +if {[string match ::* $proc]} { + set absolute_proc $proc + set relative_proc [string range $proc 2 end] +} else { + set absolute_proc ::$proc + set relative_proc $proc +} + +set documented_call [nsv_exists api_proc_doc $relative_proc] +if {$documented_call} { + set proc_index $relative_proc +} else { + set documented_call [nsv_exists api_proc_doc $absolute_proc] + set proc_index $absolute_proc +} + +if { !$documented_call } { + if {[info procs $absolute_proc] eq $absolute_proc} { + + template::head::add_style -style {pre.code { + background: #fefefa; + border-color: #aaaaaa; + border-style: solid; + border-width: 1px; + }} set error_msg [subst { -
This procedure is defined in the server but not - documented via ad_proc or proc_doc and may be intended as - a private interface.
The procedure is defined as: -
- proc $proc {[info args $proc]} {
- [ad_quotehtml [info body $proc]]
- }
-
- }]
- } elseif {[info commands ::$proc] eq "::$proc"} {
+ This procedure is defined in the server but not + documented via ad_proc or proc_doc and may be intended as + a private interface.
The procedure is defined as: +
+proc $proc {[info args $proc]} {
+ [ad_quotehtml [info body $proc]]
+}
+
+ }]
+ } elseif {[info commands $absolute_proc] eq $absolute_proc} {
- set result [util_memoize [list ::util::http::get -url $::apidoc::ns_api_html_index]]
- set page [dict get $result page]
+ set result [util_memoize [list ::util::http::get -url $::apidoc::ns_api_html_index]]
+ set page [dict get $result page]
- set url [apidoc::search_on_webindex \
- -page $page \
- -root $::apidoc::ns_api_root \
- -host $::apidoc::ns_api_host \
- -proc $proc]
-
- if {$url ne ""} {
- ns_log notice "got URL <$url>"
- ad_returnredirect -allow_complete_url $url
- ad_script_abort
- }
+ set url [apidoc::search_on_webindex \
+ -page $page \
+ -root $::apidoc::ns_api_root \
+ -host $::apidoc::ns_api_host \
+ -proc $relative_proc]
+
+ if {$url ne ""} {
+ ns_log notice "got URL <$url>"
+ ad_returnredirect -allow_complete_url $url
+ ad_script_abort
+ }
- set result [util_memoize [list ::util::http::get -url $::apidoc::tcl_api_html_index]]
- set page [dict get $result page]
+ set result [util_memoize [list ::util::http::get -url $::apidoc::tcl_api_html_index]]
+ set page [dict get $result page]
- # Strip the end of the Tcl-URL to obtain the root
- regexp {^(.*)/[^/]+} $::apidoc::tcl_api_html_index _ root
- append root /
+ # Strip the end of the Tcl-URL to obtain the root
+ regexp {^(.*)/[^/]+} $::apidoc::tcl_api_html_index _ root
+ append root /
- set url [apidoc::search_on_webindex -page $page \
- -root $root -host $root -proc $proc]
-
- if {$url ne ""} {
- ad_returnredirect -allow_complete_url $url
- ad_script_abort
- }
+ set url [apidoc::search_on_webindex -page $page -root $root -host $root -proc $proc]
+
+ if {$url ne ""} {
+ ad_returnredirect -allow_complete_url $url
+ ad_script_abort
+ }
set error_msg [subst {
- The command $proc is an available command on - the server and might be found in the Tcl - or [ns_info name] - documentation or in documentation for a loadable module. -
- }] +The command $proc is an available command on + the server and might be found in the Tcl + or [ns_info name] + documentation or in documentation for a loadable module. +
+ }] } else { set error_msg "The procedure $proc is not defined in the server.
" } } else { if { $source_p } { - set documentation [api_proc_documentation -script -xql -source $proc] + set documentation [api_proc_documentation -script -xql -source $proc_index] } else { - set documentation [api_proc_documentation -script $proc] + set documentation [api_proc_documentation -script $proc_index] } } + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: