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.19 -r1.20
--- openacs-4/packages/acs-api-browser/tcl/acs-api-documentation-procs.tcl	19 Mar 2005 14:06:31 -0000	1.19
+++ openacs-4/packages/acs-api-browser/tcl/acs-api-documentation-procs.tcl	9 Oct 2005 20:36:19 -0000	1.20
@@ -423,6 +423,8 @@
 	-script:boolean
 	-source:boolean
 	-xql:boolean
+        -label
+        {-first_line_tag <h3>}
 	proc_name
 } {
 
@@ -434,6 +436,8 @@
 	@param xql include the source code for the related xql files?
 	@param source include the source code for the script?
 	@param proc_name the name of the procedure for which to generate documentation.
+	@param label the label printed for the proc in the header line
+	@param first_line_tag tag for the markup of the first line
 	@return the formatted documentation string.
 	@error if the procedure is not defined.	   
 } {
@@ -444,22 +448,65 @@
 	array set doc_elements [nsv_get api_proc_doc $proc_name]
 	array set flags $doc_elements(flags)
 	array set default_values $doc_elements(default_values)
-	
+
+        if {![info exists label]} {
+	        set label $proc_name
+        }
 	if { $script_p } {
-		append out "<h3>[api_proc_pretty_name $proc_name]</h3>"
+                set pretty_name [api_proc_pretty_name -label $label $proc_name]
 	} else {
-		append out "<h3>[api_proc_pretty_name -link $proc_name]</h3>"
+                set pretty_name [api_proc_pretty_name -link -label $label $proc_name]
 	}
-	
-	lappend command_line $proc_name
+        if {[regexp {<([^ >]+)} $first_line_tag match tag]} {
+	        set end_tag "</$tag>"
+	} else {
+	        set first_line_tag "<h3>"
+	        set end_tag "</h3>"
+	}
+        append out $first_line_tag$pretty_name$end_tag
+        
+        if {[regexp {^(.*) (inst)?proc (.*)$} $proc_name match cl prefix method]} {
+	  set xotcl 1
+	  set scope ""
+	  if {[regexp {^(.+) (.+)$} $cl match scope cl]} {
+	    set cl "$scope do $cl"
+	  }
+	  if {[string equal "" $prefix]} {
+	    set pretty_proc_name "[::xotcl::api object_link $scope $cl] $method"
+	  } else {
+	    set pretty_proc_name \
+		"<i>&lt;instance of\
+		[::xotcl::api object_link $scope $cl]&gt;</i> $method"
+	  }
+	} else {
+	  set xotcl 0
+          set pretty_proc_name $proc_name
+	}
+
+	lappend command_line $pretty_proc_name
 	foreach switch $doc_elements(switches) {
-		if { [lsearch $flags($switch) "boolean"] >= 0 } {
-			lappend command_line "\[ -$switch \]"
+	  if {$xotcl} {
+	    if { [lsearch $flags($switch) "boolean"] >= 0} {
+	      set value "<i>on|off</i> "
+	    } elseif { [lsearch $flags($switch) "switch"] >= 0} {
+	      set value ""
+	    } else {
+	      set value "</i>$switch</i> "
+	    }
+	    if { [lsearch $flags($switch) "required"] >= 0} {
+	      lappend command_line "-$switch $value"
+	    } else {
+	      lappend command_line "\[ -$switch $value\]"
+	    }
+	  } else {
+	    if { [lsearch $flags($switch) "boolean"] >= 0} {
+	                lappend command_line "\[ -$switch \]"
 		} elseif { [lsearch $flags($switch) "required"] >= 0 } {
 			lappend command_line "-$switch <i>$switch</i>"
 		} else {
 			lappend command_line "\[ -$switch <i>$switch</i> \]"
 		}
+	  }
 	}
 	
 	set counter 0
@@ -580,7 +627,7 @@
 </dd><p>\n"
 		} else {
 		append out "<dt><b>Source code:</b></dt><dd>
-<pre>[ns_quotehtml [info body $proc_name]]<pre>
+<pre>[ns_quotehtml [api_get_body $proc_name]]<pre>
 </dd><p>\n"
 	        }
         }
@@ -626,14 +673,20 @@
 
 ad_proc api_proc_pretty_name { 
     -link:boolean
+    -label
     proc 
 } {
     Return a pretty version of a proc name
+   @param label the label printed for the proc in the header line
+   @param link provide a link to the documentation pages
 } {
+    if {![info exists label]} {
+        set label $proc
+    }
     if { $link_p } {
-	append out "<a href=\"[api_proc_url $proc]\">$proc</a>"
+	append out "<a href=\"[api_proc_url $proc]\">$label</a>"
     } else {	
-	append out "$proc"
+	append out "$label"
     }
     array set doc_elements [nsv_get api_proc_doc $proc]
     if { $doc_elements(public_p) } {
@@ -748,6 +801,38 @@
     return $matches
 }
 
+ad_proc -private api_is_xotcl_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
+  if {[string match ::* $proc_name]} { ;# only check for absolute names
+    catch {set result [::xotcl::api inscope $scope ::xotcl::Object isobject $proc_name]}
+  }
+  return $result
+}
+
+ad_proc -public api_get_body {proc_name} {
+  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 {[regexp {^(.*) (.*)$} $obj match thread obj]} {
+      # the definition is located in a disconnected thread
+      return [$thread do ::Serializer methodSerialize $obj $method $prefix]
+    } else {
+      # the definition is locally in the connection thread
+      return [::Serializer methodSerialize $obj $method $prefix]
+    }
+  } else {
+    return [info body $proc_name]
+  }
+}
+
+
 ad_proc -private api_tcl_to_html {proc_name} {
 
     Given a proc name, formats it as HTML, including highlighting syntax in
@@ -789,7 +874,7 @@
 
     # Returns length of subexpression, from open to close quote inclusive
     proc length_string {data} {
-        regexp -indices {[^\\]"} $data match
+        regexp -indices {[^\\]\"} $data match
         return [expr [lindex $match 1]+1]
     }
 
@@ -859,6 +944,8 @@
         /str      {</FONT>}
         var       {<FONT color=#660066>}
         /var      {</FONT>}
+        object	  {<FONT color=#000066><b>}
+        /object	  {</b></FONT>}
     }
 
     # Keywords will be colored as other procs, but not hyperlinked
@@ -878,6 +965,17 @@
         {gets puts socket tell format scan} \
         ]
 
+    if {[string compare "" [info command ::xotcl::api]]} {
+      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] ..
+      # [::xotcl::Object info methods] [::xotcl::Class info methods] ]]
+      set scope [::xotcl::api scope_from_proc_index $proc_name]
+    } else {
+      set XOTCL_KEYWORDS {}
+      set scope ""
+    }
+
     # Returns a list of the commands from all namespaces.
     proc list_all_procs {{parentns ::}} {
         set result [info commands ${parentns}::*]
@@ -892,7 +990,8 @@
     set proc_namespace ""
     regexp {^(::)?(.*)::[^:]+$} $proc_name match colons proc_namespace
 
-    set data "\n[info body $proc_name]"
+    set data \n[api_get_body $proc_name]
+
     regsub -all {&} $data {\&amp;} data
     regsub -all {<} $data {\&lt;} data
     regsub -all {>} $data {\&gt;} data
@@ -996,20 +1095,35 @@
                 set procl [length_proc [string range $data $i end]]
                 set proc_name [string range $data $i [expr $i + $procl]]
 
-                if {[lsearch -exact $KEYWORDS $proc_name] != -1 ||
-                    ([regexp {^::(.*)} $proc_name match had_colons] && [lsearch -exact $KEYWORDS $had_colons] != -1)} {
-                    append html "$HTML(procs)${proc_name}$HTML(/procs)"
+	        if {[lsearch -exact $KEYWORDS $proc_name] != -1 ||
+                    ([regexp {^::(.*)} $proc_name match had_colons] && 
+		     [lsearch -exact $KEYWORDS $had_colons] != -1)} {
+		  append html "$HTML(procs)${proc_name}$HTML(/procs)"
+                } elseif {[lsearch -exact $XOTCL_KEYWORDS $proc_name] != -1 } {
+		  append html "$HTML(procs)${proc_name}$HTML(/procs)"
+                } elseif {[api_is_xotcl_object $scope $proc_name]} {
+		  set url [::xotcl::api object_url \
+			       -show_source 1 -show_methods 2 \
+			       $scope $proc_name]
+		  append html "<A style='text-decoration:none' href=\
+			'$url'>$HTML(object)${proc_name}$HTML(/object)</A>"
                 } elseif {[string match "ns*" $proc_name]} {
-                    append html "<A style=\"text-decoration:none\" href=\"tcl-proc-view?tcl_proc=$proc_name\">$HTML(procs)${proc_name}$HTML(/procs)</A>"
+		  set url "tcl-proc-view?tcl_proc=$proc_name"
+		  append html "<A style='text-decoration:none' href=\
+ 			'$url'>$HTML(procs)${proc_name}$HTML(/procs)</A>"
                 } elseif {[string match "*__arg_parser" $proc_name]} {
-                   append html "$HTML(procs)${proc_name}$HTML(/procs)"
+		  append html "$HTML(procs)${proc_name}$HTML(/procs)"
                 } elseif {[lsearch -exact $COMMANDS ::${proc_namespace}::${proc_name}] != -1}  {
-                    append html "<A style=\"text-decoration:none\" href=\"[api_proc_url ${proc_namespace}::${proc_name}]\">$HTML(procs)${proc_name}$HTML(/procs)</A>"
+		  set url [api_proc_url ${proc_namespace}::${proc_name}]
+		  append html "<A style='text-decoration:none' href=\
+			'$url'>$HTML(procs)${proc_name}$HTML(/procs)</A>"
                 } elseif {[lsearch -exact $COMMANDS ::$proc_name] != -1}  {
-                    append html "<A style=\"text-decoration:none\" href=\"[api_proc_url $proc_name]\">$HTML(procs)${proc_name}$HTML(/procs)</A>"
+		  set url [api_proc_url $proc_name]
+		  append html "<A style='text-decoration:none' href=\
+			'$url'>$HTML(procs)${proc_name}$HTML(/procs)</A>"
                 } else {
-                    append html ${proc_name}
-                    set proc_ok 1
+		  append html ${proc_name}
+		  set proc_ok 1
                 }
                 incr i $procl