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 -r1.7
--- openacs-4/packages/acs-api-browser/www/proc-view.tcl	2 May 2005 21:13:53 -0000	1.6
+++ openacs-4/packages/acs-api-browser/www/proc-view.tcl	27 Oct 2014 16:39:00 -0000	1.7
@@ -3,9 +3,9 @@
     
     @cvs-id $Id$
 } {
-    proc
+    proc:trim
     source_p:optional,integer,trim
-    {version_id ""}
+    {version_id:naturalnum,optional ""}
 } -properties {
     title:onevalue
     context:onevalue
@@ -19,41 +19,118 @@
 set title $proc
 
 set context [list]
-if { [exists_and_not_null version_id] } {
-    db_1row package_info_from_package_id {
+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
     }
-    lappend context [list "package-view?version_id=$version_id&kind=procs" "$pretty_name $version_name"]
+    if {[info exists package_id]} {
+        lappend context [list "package-view?version_id=$version_id&kind=procs" \
+                             "$pretty_name $version_name"]
+    }
 }
 lappend context [list $proc]
 
 set default_source_p [ad_get_client_property -default 0 acs-api-browser api_doc_source_p]
-set return_url [ns_urlencode [ad_conn url]?[export_url_vars proc version_id]]
+set return_url [ns_urlencode [ad_conn url]?[export_vars -url {proc version_id}]]
 set error_msg ""
 
 if { ![info exists source_p] } {
     set source_p $default_source_p
 }
 
-# Try and be helpful about the procedure.
-if { ![nsv_exists api_proc_doc $proc] } {
-    if {![empty_string_p [namespace eval :: [list info procs $proc]]]} { 
-        set error_msg "<p>This procedure is defined in the server but not documented via ad_proc or proc_doc and may be intended as a private interface.</p><p>The procedure is defined as: <pre>
+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 {
+            <p>This procedure is defined in the server but not
+            documented via ad_proc or proc_doc and may be intended as
+            a private interface.</p><p>The procedure is defined as:
+<pre class='code'>
 proc $proc {[info args $proc]} {
-[ad_quotehtml [info body $proc]]
-}</pre></p>"
-    } elseif {![empty_string_p [namespace eval :: [list info commands $proc]]]} { 
-        set error_msg "<p>The procedure <b>$proc</b> is an available command on the server and might be found in the <a href=\"http://dev.scriptics.com/man/tcl8.3/TclCmd/contents.htm\">TCL</a> or <a href=\"http://www.aolserver.com/docs/devel/tcl/api/\">AOLServer</a> documentation or in documentation for a loadable module (like ns_cache for example).</p>"
+    [ad_quotehtml [info body $proc]]
+}
+</pre></p>
+        }]
+    } 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 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]
+
+        # 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 error_msg [subst {
+
+            <p>The command <b>$proc</b> is an available command on
+            the server and might be found in the <a
+            href="$::apidoc::tcl_api_html_index">Tcl</a>
+            or <a href="$::apidoc::ns_api_html_index">[ns_info name]</a>
+            documentation or in documentation for a loadable module.
+            </p>
+        }]
+
     } else { 
         set error_msg "<p>The procedure <b>$proc</b> is not defined in the server.</p>"
     }
 } 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: