--- acs-api-browser/tcl/acs-api-documentation-procs.tcl-orig 2005-03-19 15:06:31.000000000 +0100 +++ acs-api-browser/tcl/acs-api-documentation-procs.tcl 2005-11-21 23:36:28.000000000 +0100 @@ -261,7 +261,9 @@ } ad_proc -private api_format_see { see } { - regsub -all {proc *} $see {} see + regsub -all {proc +} $see {} see + regsub -all -- {\+(instproc|proc|instforward|forward)\+} $see { \1 } see + set see [string trim $see] if {[nsv_exists api_proc_doc $see]} { return "$see" @@ -423,6 +425,8 @@ -script:boolean -source:boolean -xql:boolean + -label + {-first_line_tag
\n" } else { append out "
[ns_quotehtml [info body $proc_name]]+[ns_quotehtml [api_get_body $proc_name]]
\n" } } @@ -626,14 +675,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 "$proc" + append out "$label" } else { - append out "$proc" + append out "$label" } array set doc_elements [nsv_get api_proc_doc $proc] if { $doc_elements(public_p) } { @@ -748,6 +803,46 @@ 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|forward) (.*)$} $proc_name match obj prefix kind method]} { + if {$kind eq "proc"} { + 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 { + if {[regexp {^(.*) (.*)$} $obj match thread obj]} { + return [concat $proc_name [$thread do $obj info ${prefix}forward -definition $method]] + } else { + return [concat $proc_name [$obj info ${prefix}forward -definition $method]] + } + } + } 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 +884,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 +954,8 @@ /str {} var {} /var {} + object {} + /object {} } # Keywords will be colored as other procs, but not hyperlinked @@ -878,6 +975,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 +1000,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 {\&} data regsub -all {<} $data {\<} data regsub -all {>} $data {\>} data @@ -996,20 +1105,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 "$HTML(object)${proc_name}$HTML(/object)" } elseif {[string match "ns*" $proc_name]} { - append html "$HTML(procs)${proc_name}$HTML(/procs)" + set url "tcl-proc-view?tcl_proc=$proc_name" + append html "$HTML(procs)${proc_name}$HTML(/procs)" } 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 "$HTML(procs)${proc_name}$HTML(/procs)" + set url [api_proc_url ${proc_namespace}::${proc_name}] + append html "$HTML(procs)${proc_name}$HTML(/procs)" } elseif {[lsearch -exact $COMMANDS ::$proc_name] != -1} { - append html "$HTML(procs)${proc_name}$HTML(/procs)" + set url [api_proc_url $proc_name] + append html "$HTML(procs)${proc_name}$HTML(/procs)" } else { - append html ${proc_name} - set proc_ok 1 + append html ${proc_name} + set proc_ok 1 } incr i $procl