Index: openacs-4/packages/acs-content-repository/tcl/content-extlink-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/content-extlink-procs.tcl,v diff -u -r1.10 -r1.11 --- openacs-4/packages/acs-content-repository/tcl/content-extlink-procs.tcl 25 Jul 2018 18:54:12 -0000 1.10 +++ openacs-4/packages/acs-content-repository/tcl/content-extlink-procs.tcl 25 Jul 2018 19:00:06 -0000 1.11 @@ -1,9 +1,9 @@ -# packages/acs-content-repository/tcl/content-extlink-procs.tcl +# packages/acs-content-repository/tcl/content-extlink-procs.tcl ad_library { - + Procedures for content_extlink - + @author Dave Bauer (dave@thedesignexperience.org) @creation-date 2004-06-09 @arch-tag: f8f62c6c-bf3b-46d9-8e1e-fa5e60ba1c05 @@ -20,7 +20,7 @@ } { @param extlink_id extlink to copy @param target_folder_id folder to copy extlink into - @param creation_user + @param creation_user @param creation_ip @return 0 } { Index: openacs-4/packages/acs-templating/tcl/doc-tcl-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/doc-tcl-procs.tcl,v diff -u -r1.18 -r1.19 --- openacs-4/packages/acs-templating/tcl/doc-tcl-procs.tcl 25 Jul 2018 18:54:12 -0000 1.18 +++ openacs-4/packages/acs-templating/tcl/doc-tcl-procs.tcl 25 Jul 2018 19:00:06 -0000 1.19 @@ -27,49 +27,49 @@ ad_proc -private doc::util::sort_see { element1 element2 } { used to sort the see list, which has structure [name {name} type {type} url {url}] @param element1 the first of the two list elements to be compared - @param element2 {default actually, no default value for this because it is required} the + @param element2 {default actually, no default value for this because it is required} the second of the two elements to be compared } { - + if { [lindex $element1 3 ] < [lindex $element2 3] } { - return -1 + return -1 } - + if { [lindex $element1 3 ] > [lindex $element2 3] } { - return 1 + return 1 } - + return [string compare -nocase [lindex $element1 1] [lindex $element2 1]] } ad_proc -private doc::sort_@see { list_ref directive_comments } { procedure to deal with @see comments } { - upvar $list_ref see_list + upvar $list_ref see_list - lassign $directive_comments type see_name url + lassign $directive_comments type see_name url - if {$url eq "" } { - switch -exact $type { + if {$url eq "" } { + switch -exact $type { - namespace { - set url "[doc::util::dbl_colon_fix $see_name].html" - } + namespace { + set url "[doc::util::dbl_colon_fix $see_name].html" + } - proc { - set split_name $see_name - doc::util::text_divider split_name :: - set name_length [llength $split_name] - set see_namespace [join [lrange $split_name 0 $name_length-2] ""] - set url "[doc::util::dbl_colon_fix $see_namespace].html#[set see_name]" - } + proc { + set split_name $see_name + doc::util::text_divider split_name :: + set name_length [llength $split_name] + set see_namespace [join [lrange $split_name 0 $name_length-2] ""] + set url "[doc::util::dbl_colon_fix $see_namespace].html#[set see_name]" + } + } } - } - lappend see_list [list name "$see_name" \ - type "$type" \ - url "$url" ] - set see_list [lsort -command doc::util::sort_see $see_list] + lappend see_list [list name "$see_name" \ + type "$type" \ + url "$url" ] + set see_list [lsort -command doc::util::sort_see $see_list] } @@ -90,21 +90,21 @@ @see doc::util::text_divider } { - set indices_list [list] - set last_index -1 - - while { [regexp -indices $marker $text marker_idx] } { - lappend indices_list [expr {[lindex $marker_idx 0] + $last_index}] - set text [string range $text [lindex $marker_idx 1]+1 end] - set last_index [expr {[lindex $marker_idx 1] + $last_index + 1}] - } + set indices_list [list] + set last_index -1 - # check for cases with no markers - if { [llength $indices_list ] == 0 } { - set indices_list [list end] - } + while { [regexp -indices $marker $text marker_idx] } { + lappend indices_list [expr {[lindex $marker_idx 0] + $last_index}] + set text [string range $text [lindex $marker_idx 1]+1 end] + set last_index [expr {[lindex $marker_idx 1] + $last_index + 1}] + } - return $indices_list + # check for cases with no markers + if { [llength $indices_list ] == 0 } { + set indices_list [list end] + } + + return $indices_list } ad_proc -private doc::util::text_divider { text_ref marker } { @@ -117,25 +117,25 @@ @see doc::util::find_marker_indices } { upvar $text_ref text - + set indices_list [doc::util::find_marker_indices $text $marker] set result_list [list] # first check for no markers present if { $indices_list eq "end" } { - set text [list $text] - return 0 + set text [list $text] + return 0 } - + set old_index 0 foreach index $indices_list { - lappend result_list [string range $text $old_index $index] - set old_index [expr {$index + 1}] + lappend result_list [string range $text $old_index $index] + set old_index [expr {$index + 1}] } - + lappend result_list [string range $text $old_index end] - + set text $result_list return 1 } @@ -144,27 +144,27 @@ ad_proc -private template::util::write_from_template { template file_name} { takes a .adp template name and the name of the file to be written and creates the file; also puts out a notice before - + @param template the name of the template to be used in making the file @param file_name the name of the file to be created } { - upvar template_name template_name - set template_name $template - uplevel { - set read_template [template::util::read_file $template_name] - set code [template::adp_compile -string $read_template] - set output [template::adp_eval code] - } - upvar output output - template::util::write_to_file $file_name "$output" + upvar template_name template_name + set template_name $template + uplevel { + set read_template [template::util::read_file $template_name] + set code [template::adp_compile -string $read_template] + set output [template::adp_eval code] + } + upvar output output + template::util::write_to_file $file_name "$output" } ad_proc -private template::util::quote_space {text} { just takes a body of text and puts a space behind every double quote; this is done so that the text body can be treated as a list - without causing problems resulting from list elements + without causing problems resulting from list elements being separated by characters other than a space @param text req/none the body of text to be worked on @@ -208,7 +208,7 @@ from a body of commented text @param text @return text -} { +} { regsub -all {"} $text {\"} text regsub -all {(\n)\s*#\s*} $text {\1 } text regsub {(\A)\s*#\s*} $text {\1 } text @@ -217,7 +217,7 @@ ad_proc -private template::util::alphabetized_index {list entry} { takes an alphabetized list and an entry - + @param list {let's see how this parses out} the alphabetized list @param entry req the value to be inserted @@ -227,15 +227,15 @@ set result [lsearch -exact $list $entry] if { $result != -1 } { - return -1 + return -1 } - + for {set i 0} {$i < [llength $list] } { incr i } { - if { [string compare -nocase $entry [lindex $list $i]] < 0 } { - return $i - } + if { [string compare -nocase $entry [lindex $list $i]] < 0 } { + return $i + } } - + return $i } @@ -257,7 +257,7 @@ upvar comment_text comment_text doc::util::text_divider proc_block {\n\s*proc\s+} - + set comment_text [lindex $proc_block 0] set source_text [join [lrange $proc_block 1 end] "" ] @@ -283,7 +283,7 @@ #set these values to blank in case they are not specified in the comment text foreach column { description author return } { - set info_$column "" + set info_$column "" } # if we wanted to include the source text for the procedure as well: @@ -297,50 +297,50 @@ foreach directive $directives { - set directive_type [lindex $directive 0] - set directive_comments [template::util::quote_space [lindex $directive 1]] + set directive_type [lindex $directive 0] + set directive_comments [template::util::quote_space [lindex $directive 1]] - switch -exact $directive_type { - - public - + switch -exact $directive_type { - private { - set public_private $directive_type - set info_description [lrange $directive_comments 1 end ] - } + public - - author - - - return { - set info_$directive_type $directive_comments - } + private { + set public_private $directive_type + set info_description [lrange $directive_comments 1 end ] + } - option - + author - - param { - set directive_name [lindex $directive_comments 0] + return { + set info_$directive_type $directive_comments + } - if { [string match -nocase {default *} [lindex $directive_comments 1]] } { - lappend proc_$directive_type [list name "$directive_name" \ - default "[lrange [lindex $directive_comments 1] 1 end]" \ - description "[lrange $directive_comments 2 end]" ] - } else { - if {$directive_type eq "param"} { - set default_comment "required" - } else { - set default_comment "" - } - lappend proc_$directive_type [list name "$directive_name" \ - default "$default_comment" \ - description "[lrange $directive_comments 1 end]" ] - - } - } + option - - see { - doc::sort_@see proc_$directive_type $directive_comments - } - } + param { + set directive_name [lindex $directive_comments 0] + + if { [string match -nocase {default *} [lindex $directive_comments 1]] } { + lappend proc_$directive_type [list name "$directive_name" \ + default "[lrange [lindex $directive_comments 1] 1 end]" \ + description "[lrange $directive_comments 2 end]" ] + } else { + if {$directive_type eq "param"} { + set default_comment "required" + } else { + set default_comment "" + } + lappend proc_$directive_type [list name "$directive_name" \ + default "$default_comment" \ + description "[lrange $directive_comments 1 end]" ] + + } + } + + see { + doc::sort_@see proc_$directive_type $directive_comments + } + } } set proc_info [list proc_name "$proc_name" author "$info_author" description "$info_description" return "$info_return" ] @@ -356,7 +356,7 @@ } ad_proc -private doc::parse_namespace { text_lines } { - text between two namespace markers in a Tcl library file and + text between two namespace markers in a Tcl library file and parses out procedure source and comments @author simon @@ -372,11 +372,9 @@ set text_list $text_lines if { [doc::util::text_divider text_list {\n#\s*@(?:public|private)\s+} ] } { - - # @private or @public directives were found, continue with parsing + # @private or @public directives were found, continue with parsing } else { - - return 0 + return 0 } # before parsing out the proc info, we'll deal with the comments for the namespace itself @@ -401,60 +399,59 @@ set namespace_name [lindex $directive_comments 0] set namespace_description [lrange $directive_comments 1 end] if {$namespace_description ne "" } { - set has_comments 1 - } + set has_comments 1 + } } see { - doc::sort_@see namespace_$directive_type $directive_comments - set has_comments 1 - + doc::sort_@see namespace_$directive_type $directive_comments + set has_comments 1 } author { set namespace_author $directive_comments - set has_comments 1 + set has_comments 1 } } } # the variable has_comments is set to 1 if it appears # as though descriptive comments were written to describe the namespace -- - # as would be expected if the namespace were being described + # as would be expected if the namespace were being described # for the first time; otherwise - # it is set to 0; the problem i'm trying to resolve here is multiple uses - # of the @namespace directive and determining which occurrence of the + # it is set to 0; the problem i'm trying to resolve here is multiple uses + # of the @namespace directive and determining which occurrence of the # directive is followed by comments # by comments we want to parse into our static files - # namespace_index tells us where to insert the info, or is -1 if + # namespace_index tells us where to insert the info, or is -1 if # the namespace has already been described set namespace_index [template::util::alphabetized_index $namespace_list $namespace_name] if { $namespace_index == -1 } { - # this namespace is already recorded, so we will just add - # or revise info about its procs + # this namespace is already recorded, so we will just add + # or revise info about its procs set namespace_entry [lindex $total_result_listing [lsearch -exact $namespace_list $namespace_name]] - set namespace_info [lindex $namespace_entry 0 1] - set namespace_public [lindex $namespace_entry 1 1] - set namespace_private [lindex $namespace_entry 2 1] - + set namespace_info [lindex $namespace_entry 0 1] + set namespace_public [lindex $namespace_entry 1 1] + set namespace_private [lindex $namespace_entry 2 1] + } else { set namespace_info [list name "$namespace_name" overview "$namespace_description" author "$namespace_author" see "$namespace_see"] - set namespace_public "" - set namespace_private "" - + set namespace_public "" + set namespace_private "" + } - + if { $has_comments } { - - # this check determines whether or not we want the comments - # following this occurrence of the @namespace directive for - # this namespace to be included in our static files + # this check determines whether or not we want the comments + # following this occurrence of the @namespace directive for + # this namespace to be included in our static files + set namespace_info [list name "$namespace_name" overview "$namespace_description" author "$namespace_author" see "$namespace_see"] } @@ -463,25 +460,25 @@ foreach proc_block $procedure_list { - # each pro_block text block contains both the directive-marked comments and - # the source code for the procedure - doc::parse_comment_text $proc_block + # each pro_block text block contains both the directive-marked comments and + # the source code for the procedure + doc::parse_comment_text $proc_block } if { $namespace_index >= 0 } { - # if the namespace has not already been described, then we group all info together - # {{info - name, overview} {public proc info} {private proc info}} - # and insert it into the monster list of all namespaces + # if the namespace has not already been described, then we group all info together + # {{info - name, overview} {public proc info} {private proc info}} + # and insert it into the monster list of all namespaces - set total_result_listing [linsert $total_result_listing $namespace_index [list [list info $namespace_info] [list public $namespace_public] [list private $namespace_private]]] - - set namespace_list [linsert $namespace_list $namespace_index $namespace_name] + set total_result_listing [linsert $total_result_listing $namespace_index [list [list info $namespace_info] [list public $namespace_public] [list private $namespace_private]]] + set namespace_list [linsert $namespace_list $namespace_index $namespace_name] + } else { - - # the name and overview info is already set, we'll just replace the augmented - # listings for private and public procedures + # the name and overview info is already set, we'll just replace the augmented + # listings for private and public procedures + set namespace_index [lsearch -exact $namespace_list $namespace_name ] lset total_result_listing $namespace_index [list [list info "$namespace_info"] [list public "$namespace_public"] [list private "$namespace_private"]] @@ -499,7 +496,7 @@ directives.
  • When one of these directives is encountered, the file is scanned up to a proc declaration and the text in between is parsed as documentation - for a single procedure. + for a single procedure.
  • The text between the initial @private or @public directive and the next directive is considered a general comment on the procedure @@ -509,9 +506,9 @@
  • @author
  • @param (for hard parameters)
  • @see (should have the form namespace::procedure. A reference to an - entire namespace should be namespace::. By convention the - API for each namespace should be in a file of the same name, - so that a link can be generated automatically). + entire namespace should be namespace::. By convention the + API for each namespace should be in a file of the same name, + so that a link can be generated automatically).
  • @option (for switches such as -foo)
  • @return @@ -523,84 +520,76 @@ documentation.

    creates a multirow variable in the variable name designated by result_ref - with columns namespace_name, proc_name, public_private, + with columns namespace_name, proc_name, public_private, author, param, option, see, return and source_text

    Note that this format is suitable for passing to array set for creating a lookup on namespace name. } { - set text [template::util::read_file $path] + set text [template::util::read_file $path] - if { [doc::util::text_divider text {\n#\s*@namespace\s+} ] } { + if { [doc::util::text_divider text {\n#\s*@namespace\s+} ] } { - # the @namespace directive was found, proceed with parsing through comment text - set result_list [lrange $text 1 end] + # the @namespace directive was found, proceed with parsing through comment text + set result_list [lrange $text 1 end] - foreach namespace_body $result_list { - doc::parse_namespace $namespace_body - } + foreach namespace_body $result_list { + doc::parse_namespace $namespace_body + } + return 1 + } else { - return 1 - } else { - - # no @namespace directives found - return 0 - } - + # no @namespace directives found + return 0 + } } ad_proc -private doc::parse_tcl_library { dir_list } { takes the absolute path of the Tcl library directory and parses through it - @see doc::parse_file + @see doc::parse_file @see template::util::comment_text_normalize - @return a long lists of lists of lists, each list element contains - a three-element list of the format + @return a long lists of lists of lists, each list element contains + a three-element list of the format - { {info} {public procedures listing } {private procedures listing}} } { - # namespace_list will be a list containing namespace names only, and should be ordered - # with respect to namespaces in the same order as the list result + # namespace_list will be a list containing namespace names only, and should be ordered + # with respect to namespaces in the same order as the list result - upvar namespace_list namespace_list - set namespace_list [list] + upvar namespace_list namespace_list + set namespace_list [list] - set result [list] + set result [list] - foreach dir $dir_list { + foreach dir $dir_list { - #debug - #template::util::display_value dir + #debug + #template::util::display_value dir - # using this lame hack since most aD servers are running an earlier version of Tcl than 8.3, - # which supports the -directory switch that this hack emulates - append file_list [glob -nocomplain $dir/*.tcl $dir/*/*.tcl $dir/*/*/*.tcl $dir/*/*/*/*.tcl ] - append file_list " " - } + # using this lame hack since most aD servers are running an earlier version of Tcl than 8.3, + # which supports the -directory switch that this hack emulates + append file_list [glob -nocomplain $dir/*.tcl $dir/*/*.tcl $dir/*/*/*.tcl $dir/*/*/*/*.tcl ] + append file_list " " + } - #debugging - #template::util::display_value file_list + #debugging + #template::util::display_value file_list - foreach tcl_file $file_list { - ns_log notice "doc::parse_tcl_library: parsing through $tcl_file for documentation" - - set comments_parsed_p [doc::parse_file $tcl_file] - if {! $comments_parsed_p } { - ns_log notice "doc::parse_tcl_library: no @namespace directives found in $tcl_file" - } - } + foreach tcl_file $file_list { + ns_log notice "doc::parse_tcl_library: parsing through $tcl_file for documentation" - return $result - + set comments_parsed_p [doc::parse_file $tcl_file] + if {! $comments_parsed_p } { + ns_log notice "doc::parse_tcl_library: no @namespace directives found in $tcl_file" + } + } + return $result } - - - - # Local variables: # mode: tcl # tcl-indent-level: 4 Index: openacs-4/packages/file-storage/tcl/file-storage-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/tcl/file-storage-procs.tcl,v diff -u -r1.87 -r1.88 --- openacs-4/packages/file-storage/tcl/file-storage-procs.tcl 25 Jul 2018 18:54:12 -0000 1.87 +++ openacs-4/packages/file-storage/tcl/file-storage-procs.tcl 25 Jul 2018 19:00:06 -0000 1.88 @@ -1166,7 +1166,7 @@ -item_id $folder_id \ -action "delete_folder" } - + db_exec_plsql delete_folder {} } @@ -1285,7 +1285,7 @@ set owner [person::name -person_id $creation_user] if {$action in {"new_file" "new_url" "new_version"}} { - + if {$action eq "new_version"} { set sql "select description as description from cr_revisions where cr_revisions.revision_id = :item_id"