[ns_quotehtml [lindex $doc_elements(cvs-id) 0]]
}]
}
@@ -293,10 +300,18 @@
return $out
}
-ad_proc -public api_type_documentation {
+ad_proc -deprecated -public api_type_documentation {
type
} {
- @return html fragment of the API docs.
+ Deprecated: this was part of a feature which used to react to the
+ 'type' property set in ad_page_contract's documentation and
+ generate an extra link in /api-doc/package-view, but currently no
+ upstream script seems to specify this value and no code seems to
+ create necessary 'doc_type_doc' nsv
+
+ @see /packages/acs-api-browser/www/type-view.tcl
+
+ @return HTML fragment of the API docs.
} {
array set doc_elements [nsv_get doc_type_doc $type]
append out "text/html and text/plain are supported.
+ @param format the type of documentation to generate. This
+ parameter is deprecated and has no effect.
@param script include information about what script this proc lives in?
@param xql include the source code for the related xql files?
@param source include the source code for the script?
@@ -381,15 +423,16 @@
#
if {[string match *::::* $proc_name]} {
ad_log warning "api_proc_documentation: received invalid proc_name <$proc_name>, try to sanitize"
- regsub -all {::::} $proc_name :: proc_name
+ regsub -all -- {::::} $proc_name :: proc_name
}
- if { $format ne "text/html" && $format ne "text/plain" } {
- return -code error "Only text/html and text/plain documentation are currently supported"
+ if {[info exists format] && ![aa_test_running_p]} {
+ ad_log warning "-format flag is deprecated and has no effect"
}
array set doc_elements {
flags ""
default_values ""
- switches ""
+ switches0 ""
+ switches1 ""
positionals ""
varargs_p 0
script ""
@@ -401,7 +444,7 @@
array set default_values $doc_elements(default_values)
if {![info exists label]} {
- if {[llength $proc_name] > 1 && [info commands ::xo::api] ne ""} {
+ if {[llength $proc_name] > 1 && [namespace which ::xo::api] ne ""} {
set label [::xo::api method_label $proc_name]
} else {
set label $proc_name
@@ -430,10 +473,15 @@
append out $first_line_tag$pretty_name$end_tag
if {[regexp {^(.*) (inst)?proc (.*)$} $proc_name match cl prefix method]
- && [info commands ::xo::api] ne ""
+ && [namespace which ::xo::api] ne ""
} {
set xotclArgs 1
set scope ""
+ #
+ # Since we get "method" via regexp, we have to remove the
+ # curly brackets for ensemble methods
+ #
+ set method [lindex $method 0]
regexp {^(.+) (.+)$} $cl match scope cl
if {$prefix eq ""} {
set pretty_proc_name "[::xo::api object_link $scope $cl] $method"
@@ -442,7 +490,7 @@
}
} else {
set xotclArgs 0
- if {[info commands ::xo::api] ne "" && [::xo::api isclass "" [lindex $proc_name 1]]} {
+ if {[namespace which ::xo::api] ne "" && [::xo::api isclass "" [lindex $proc_name 1]]} {
set name [lindex $proc_name 1]
set pretty_proc_name "[$name info class] [::xo::api object_link {} $name]"
} else {
@@ -451,29 +499,8 @@
}
lappend command_line $pretty_proc_name
- foreach switch $doc_elements(switches) {
- if {$xotclArgs} {
- if {"boolean" in $flags($switch)} {
- set value "on|off "
- } elseif {"switch" in $flags($switch)} {
- set value ""
- } else {
- set value "$switch "
- }
- if {"required" in $flags($switch)} {
- lappend command_line "-$switch $value"
- } else {
- lappend command_line "\[ -$switch $value\]"
- }
- } else {
- if {"boolean" in $flags($switch)} {
- lappend command_line "\[ -$switch \]"
- } elseif {"required" in $flags($switch)} {
- lappend command_line "-$switch $switch"
- } else {
- lappend command_line "\[ -$switch $switch \]"
- }
- }
+ foreach switch $doc_elements(switches0) {
+ lappend command_line [api_proc_format_switch $xotclArgs $flags($switch) $switch]
}
set counter 0
@@ -487,6 +514,10 @@
if { $doc_elements(varargs_p) } {
lappend command_line "\[ args... \]"
}
+ foreach switch $doc_elements(switches1) {
+ lappend command_line [api_proc_format_switch $xotclArgs $flags($switch) $switch]
+ }
+
append out [util_wrap_list $command_line]
set intro_out ""
@@ -519,10 +550,11 @@
}
}
- if { [llength $doc_elements(switches)] > 0 } {
- append blocks_out "[::apidoc::tcl_to_html $proc_name]
[ns_quotehtml [api_get_body $proc_name]]
$content"} - append there [subst {
@@ -655,7 +695,7 @@ 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 {
@@ -670,7 +710,7 @@ 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 {
@@ -680,7 +720,7 @@ lappend missing Oracle } if {[llength $missing] > 0} { - set xql_out [subst {
[ns_quotehtml [lindex $doc_elements(cvs-id) 0]][ns_quotehtml [lindex $doc_elements(cvs-id) 0]]
Known Issues:
@@ -1465,16 +1520,20 @@
} {
- if {[info commands ::xo::api] ne ""} {
+ if {[namespace which ::xo::api] ne ""} {
set scope [::xo::api scope_from_proc_index $proc_name]
} else {
set scope ""
}
set proc_namespace ""
regexp {^(::)?(.*)::[^:]+$} $proc_name match colons proc_namespace
-
return [tclcode_to_html -scope $scope -proc_namespace $proc_namespace [api_get_body $proc_name]]
+ #package req nx::pp
+ #append result \
+ # [tclcode_to_html -scope $scope -proc_namespace $proc_namespace [api_get_body $proc_name]] \
+ #
\
+ # [nx::pp render [api_get_body $proc_name]]
}
ad_proc -private length_var {data} {
@@ -1492,7 +1551,7 @@
ad_proc -private length_proc {data} {
@return Length of a command name.
} {
- if {[regexp -indices {^(::)?[A-Za-z][:A-Za-z0-9_@]+} $data found]} {
+ if {[regexp -indices {^(::)?[A-Za-z0-9][:\.\-A-Za-z0-9_@]+} $data found]} {
return [lindex $found 1]
}
return 0
@@ -1507,7 +1566,7 @@
ad_proc -private length_braces {data} {
@return length of subexpression, from open to close brace inclusive.
- Doesn't deal with unescaped braces in substrings.
+ Doesn't deal with unescaped braces in substrings.
} {
set i 1
for {set count 1} {1} {incr i} {
@@ -1561,17 +1620,30 @@
incr i [length_exp [string range $data $i end]] ;# spaces
incr i [length_exp [string range $data $i end]] ;# expression - it could be a var
}
- incr i [length_exp [string range $data $i end]]
+ set expr_length [length_exp [string range $data $i end]]
+ if {$expr_length == 0} {
+ break
+ }
+ incr i $expr_length
set curchar [string index $data $i]
}
return [expr {$i - 1}]
}
ad_proc -private search_on_webindex {-page -host -root -proc} {
- Search for a matching link in the page and return the absolute link if found
+
+ Search for a matching link in the page and return the absolute
+ link if found. Avoid in-page links (starting with "#")
+
+ @param page HTML page
+ @param host for completing URLs starting with no "/"
+ @param root for completing URLs starting with a "/"
+ @param proc name of proc as used in link label
+
} {
set url ""
- if { [regexp "\"'\]+)\[\"'\]\[^>\]*>$proc" $page match relative_url] } {
+ if { [regexp "\"'\]+)\[\"'\]\[^>\]*>$proc" \
+ $page match relative_url] } {
if {[string match "/*" $relative_url]} {
set url $host$relative_url
} else {
@@ -1619,7 +1691,7 @@
ad_proc -public tclcode_to_html {{-scope ""} {-proc_namespace ""} script} {
Given a script, this proc formats it as HTML, including highlighting syntax in
- various colors and creating hyperlinks to other proc definitions.
+ various colors and creating hyperlinks to other proc definitions.
The inspiration for this proc was the tcl2html script created by Jeff Hobbs.
@param script script to be formatted in HTML
@@ -1635,7 +1707,7 @@
# to api-doc pages. Perhaps we should hyperlink them to the Tcl man pages?
# else and elseif are be treated as special cases later
- if {[info commands ::xo::api] ne ""} {
+ if {[namespace which ::xo::api] ne ""} {
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] ..
@@ -1645,11 +1717,11 @@
}
set data [string map [list & "&" < "<" > ">"] \n$script]
-
set in_comment 0
set in_quotes 0
set proc_ok 1
set l [string length $data]
+
for {set i 0} {$i < $l} {incr i} {
set char [string index $data $i]
switch -- $char {
@@ -1708,14 +1780,35 @@
set in_comment 0
}
- "\{" -
";" {
- if {!$in_quotes} {
+ if {!$in_quotes && !$in_comment} {
set proc_ok 1
}
append html $char
}
+ "\{" {
+ if {!$in_quotes && !$in_comment} {
+ set proc_ok 1
+ set linestart [string last "\n" $data $i]
+ if {$linestart != -1} {
+ set segment [string range $data $linestart+1 $i]
+ #ns_log notice "SEGMENT <$segment>"
+ #
+ # When the line looks like from a
+ # definition of a proc/instproc/method,
+ # don't expect that the next word is a
+ # potential command, since this is rather
+ # an argument.
+ #
+ if {[regexp {(proc|method) } $segment]} {
+ set proc_ok 0
+ }
+ }
+ }
+ append html $char
+ }
+
"\}" {
append html "\}"
# Special case else and elseif
@@ -1738,6 +1831,10 @@
append html " "
}
+ "\t" {
+ append html " "
+ }
+
default {
if {$proc_ok} {
set proc_ok 0
@@ -1796,14 +1893,24 @@
}
}
}
+ continue
}
- if {$proc_name in {* @ ?}} {
+
+ #
+ # The last four words in the following clause
+ # are deprecated procs which are unfortunately
+ # picked up as commands by
+ # apidoc::tclcode_to_html. Therefore, we
+ # ignore these explicitly.
+ #
+ if {$proc_name in {* @ ? min max random content_type}} {
append html $proc_name
+
} elseif {$proc_name in $::apidoc::KEYWORDS ||
- ([regexp {^::(.*)} $proc_name match had_colons]
- && $had_colons in $::apidoc::KEYWORDS)} {
+ ([regexp {^::(.*)} $proc_name match had_colons]
+ && $had_colons in $::apidoc::KEYWORDS)} {
- set url "/api-doc/proc-view?proc=$proc_name"
+ set url "/api-doc/proc-view?proc=[string trimleft $proc_name :]"
append html "" \
[pretty_token keyword $proc_name]
@@ -1821,7 +1928,7 @@
append html [pretty_token helper $proc_name]
} elseif {$proc_namespace ne ""
- && [info commands ::${proc_namespace}::${proc_name}] ne ""} {
+ && [namespace which ::${proc_namespace}::${proc_name}] ne ""} {
if {[is_object $scope ${proc_namespace}::${proc_name}]} {
set url [::xo::api object_url \
@@ -1834,10 +1941,11 @@
append html "" \
[pretty_token proc $proc_name]
}
- } elseif {[info commands ::$proc_name] ne ""} {
+ } elseif {[namespace which ::$proc_name] ne ""} {
+
set absolute_name [expr {[string match "::*" $proc_name]
- ? $proc_name
- : "::${proc_name}"}]
+ ? $proc_name : "::${proc_name}" }]
+
if {[is_object $scope $absolute_name]} {
set url [::xo::api object_url \
-show_source 1 -show_methods 2 \
@@ -1850,8 +1958,11 @@
[pretty_token proc $proc_name]
}
} else {
+ #if {$procl > 2 && [string match ad_* $proc_name]} {
+ # ns_log notice "TCLCODE: giving up on '$proc_name' ($procl) [string range $data $i $i+20]"
+ #}
append html $proc_name
- set proc_ok 1
+ #set proc_ok 1
}
incr i $procl
@@ -1906,24 +2017,32 @@
} {
set linkList [list]
- set filename $::acs::rootdir/$path
- set path_dirname [file dirname $path]
- set file_dirname [file dirname $filename]
- set file_rootname [file rootname [file tail $filename]]
- regsub {(-oracle|-postgresql)$} $file_rootname {} file_rootname
- set files \
- [lsort -decreasing \
- [glob -nocomplain \
- -directory $file_dirname \
- "${file_rootname}{,-}{,oracle,postgresql}.{adp,tcl,xql}" ]]
+ set paths $path
+ set root_path [file rootname $path]
+ set themed_path [template::themed_template $root_path]
+ if {$themed_path ne $root_path} {
+ lappend paths $themed_path
+ }
+ foreach path $paths {
+ set filename $::acs::rootdir/$path
+ set path_dirname [file dirname $path]
+ set file_dirname [file dirname $filename]
+ set file_rootname [file rootname [file tail $filename]]
+ regsub {(-oracle|-postgresql)$} $file_rootname {} file_rootname
- foreach file $files {
+ lappend files {*}[glob -nocomplain \
+ -directory $file_dirname \
+ "${file_rootname}{,-}{,oracle,postgresql}.{adp,tcl,xql}" ]
+ }
+
+ foreach file [lsort -decreasing $files] {
set path [ns_urlencode $path_dirname/[file tail $file]]
set link [export_vars -base content-page-view {{source_p 1} path}]
- lappend linkList [list filename $file link $link]
+ set display_file [string range $file [string length $::acs::rootdir]+1 end]
+ lappend linkList [list filename $display_file link $link]
if {$include_compiled && [file extension $file] eq ".adp"} {
set link [export_vars -base content-page-view {{source_p 1} {compiled_p 1} path}]
- lappend linkList [list filename "$file (compiled)" link $link]
+ lappend linkList [list filename "$display_file (compiled)" link $link]
}
}
@@ -1964,17 +2083,17 @@
# procs for linking to libraries, pages, etc, should go here too.
#
-ad_proc api_proc_url { proc } {
+ad_proc api_proc_url { {-source:boolean 1} proc } {
@return the URL of the page that documents the given proc.
@author Lars Pind (lars@pinds.com)
@creation-date 14 July 2000
} {
- return "/api-doc/proc-view?proc=[ns_urlencode $proc]&source_p=1"
+ return "/api-doc/proc-view?proc=[ns_urlencode $proc]&source_p=$source_p"
}
ad_proc -private api_proc_doc_url {-proc_name -source_p -version_id} {
- Return the procdic url from procname and optionally from source_p and version_id
+ Return the procdoc url from procname and optionally from source_p and version_id
} {
if {[string range $proc_name 0 0] eq " " && [lindex $proc_name 0] in {Object Class}} {
set object [lindex $proc_name end]
@@ -1989,13 +2108,15 @@
return $url
}
-ad_proc api_proc_link { proc } {
+ad_proc api_proc_link { {-source:boolean 1} proc } {
@return full HTML link to the documentation for the proc.
+ @see api_proc_url
+
@author Lars Pind (lars@pinds.com)
@creation-date 14 July 2000
} {
- return "$proc"
+ return "$proc"
}
ad_proc -private api_test_case_url {testcase_pair} {