Index: openacs-4/packages/acs-admin/www/apm/version-dependency-add-2.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/version-dependency-add-2.tcl,v diff -u -r1.17 -r1.18 --- openacs-4/packages/acs-admin/www/apm/version-dependency-add-2.tcl 19 Jan 2018 13:40:40 -0000 1.17 +++ openacs-4/packages/acs-admin/www/apm/version-dependency-add-2.tcl 8 May 2018 22:37:18 -0000 1.18 @@ -1,5 +1,5 @@ ad_page_contract { - Adds a dependency to a version of a package. + Adds a dependency to a version of a package. @author Bryan Quinn @creation-date 17 April 2000 @cvs-id $Id$ @@ -12,41 +12,40 @@ } set service [split $service ";"] -set package_key [lindex $service 0] -set version_name [lindex $service 1] +lassign $service package_key version_name apm_package_install_spec $version_id db_transaction { switch -- $dependency_type { - require { - apm_dependency_add -dependency_id $dependency_id ${dependency_type}s $version_id $package_key $version_name + require { + apm_dependency_add -dependency_id $dependency_id ${dependency_type}s $version_id $package_key $version_name apm_build_one_package_relationships $our_package_key - } + } extend { - apm_dependency_add -dependency_id $dependency_id ${dependency_type}s $version_id $package_key $version_name + apm_dependency_add -dependency_id $dependency_id ${dependency_type}s $version_id $package_key $version_name apm_build_one_package_relationships $our_package_key apm_copy_inherited_params $our_package_key [list $package_key $version_name] - } + } embed { - apm_dependency_add -dependency_id $dependency_id ${dependency_type}s $version_id $package_key $version_name + apm_dependency_add -dependency_id $dependency_id ${dependency_type}s $version_id $package_key $version_name apm_build_one_package_relationships $our_package_key apm_copy_inherited_params $our_package_key [list $package_key $version_name] - } + } - default { - ad_return_complaint 1 "Entry error: Allowable dependencies are required, extends and embeds." - } + default { + ad_return_complaint 1 "Entry error: Allowable dependencies are required, extends and embeds." + } } } on_error { if { ![db_string apm_dependency_doubleclick_check { - select count(*) from apm_package_dependencies - where dependency_id = :dependency_id + select count(*) from apm_package_dependencies + where dependency_id = :dependency_id } -default 0] } { - ad_return_complaint 1 "The database returned the following error: -
" + ad_return_complaint 1 "The database returned the following error: +[ns_quotehtml $errmsg]
" } } Index: openacs-4/packages/acs-admin/www/apm/version-i18n-process.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/version-i18n-process.tcl,v diff -u -r1.6 -r1.7 --- openacs-4/packages/acs-admin/www/apm/version-i18n-process.tcl 7 Aug 2017 23:47:45 -0000 1.6 +++ openacs-4/packages/acs-admin/www/apm/version-i18n-process.tcl 8 May 2018 22:37:18 -0000 1.7 @@ -4,9 +4,9 @@ @author Peter Marklund (peter@collaboraid.biz) @creation-date 8 October 2002 - @cvs-id $Id$ + @cvs-id $Id$ } { - version_id:naturalnum,notnull + version_id:naturalnum,notnull {files:multiple} {file_action:multiple} } @@ -39,8 +39,7 @@ set full_file_name "$::acs::rootdir/$file" set adp_report_list [lang::util::replace_adp_text_with_message_tags "$::acs::rootdir/$file" report] -set adp_replace_list [lindex $adp_report_list 0] -set adp_no_replace_list [lindex $adp_report_list 1] +lassign $adp_report_list adp_replace_list adp_no_replace_list if { [llength $adp_replace_list] == 0 } { # There are no replacements to choose keys for so go straight to the processing result page Index: openacs-4/packages/acs-authentication/lib/local-search.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/lib/local-search.tcl,v diff -u -r1.4 -r1.5 --- openacs-4/packages/acs-authentication/lib/local-search.tcl 26 Apr 2018 08:56:37 -0000 1.4 +++ openacs-4/packages/acs-authentication/lib/local-search.tcl 8 May 2018 22:37:18 -0000 1.5 @@ -66,8 +66,7 @@ } set orderby_list [split $orderby ,] -set orderby_column [lindex $orderby_list 0] -set direction [lindex $orderby_list 1] +lassign $orderby_list orderby_column direction set direction [string map {asc -increasing desc -decreasing} $direction] if {$orderby_column ne ""} { template::multirow -ulevel 2 -local sort users $direction $orderby_column Index: openacs-4/packages/acs-bootstrap-installer/db-init-checks-oracle.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/db-init-checks-oracle.tcl,v diff -u -r1.9 -r1.10 --- openacs-4/packages/acs-bootstrap-installer/db-init-checks-oracle.tcl 7 Aug 2017 23:47:46 -0000 1.9 +++ openacs-4/packages/acs-bootstrap-installer/db-init-checks-oracle.tcl 8 May 2018 22:37:18 -0000 1.10 @@ -141,9 +141,7 @@ } set dbversion_list [split $dbversion .] - set dbversion_major [lindex $dbversion_list 0] - set dbversion_minor [lindex $dbversion_list 1] - set dbversion_patch [lindex $dbversion_list 2] + lassign $dbversion_list dbversion_major dbversion_minor dbversion_patch set dbversion_total [expr {($dbversion_major * 1000000) + ($dbversion_minor * 1000) + ($dbversion_patch)}] # Check for Oracle 8.1.6 and before running on Linux. If so, we've got to tell the user Index: openacs-4/packages/acs-bootstrap-installer/tcl/00-proc-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/tcl/00-proc-procs.tcl,v diff -u -r1.53 -r1.54 --- openacs-4/packages/acs-bootstrap-installer/tcl/00-proc-procs.tcl 1 May 2018 09:06:57 -0000 1.53 +++ openacs-4/packages/acs-bootstrap-installer/tcl/00-proc-procs.tcl 8 May 2018 22:37:18 -0000 1.54 @@ -361,8 +361,7 @@ foreach arg $effective_arg_list { if { [llength $arg] == 2 } { set default_p 1 - set default_value [lindex $arg 1] - set arg [lindex $arg 0] + lassign $arg arg default_value } else { if { [llength $arg] != 1 } { return -code error "Invalid element \"$arg\" in argument list" Index: openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl,v diff -u -r1.45 -r1.46 --- openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 25 Apr 2018 19:23:25 -0000 1.45 +++ openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 8 May 2018 22:37:18 -0000 1.46 @@ -530,8 +530,7 @@ break } - set one_query [lindex $result 0] - set parsing_state [lindex $result 1] + lassign $result one_query parsing_state # db_qd_log QDDebug "loaded one query - [db_fullquery_get_name $one_query]" Index: openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl,v diff -u -r1.16 -r1.17 --- openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl 1 May 2018 08:31:43 -0000 1.16 +++ openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl 8 May 2018 22:37:18 -0000 1.17 @@ -1,37 +1,37 @@ namespace eval publish { - variable item_id_stack + variable item_id_stack variable revision_html namespace eval handle {} } ad_proc -public publish::get_page_root {} { - Get the page root. All items will be published to the + Get the page root. All items will be published to the filesystem with their URLs relative to this root. The page root is controlled by the PageRoot parameter in CMS. A relative path is relative to $::acs::pageroot The default is $::acs::pageroot - + @return The page root - + @see publish::get_template_root @see publish::get_publish_roots } { # LARS TODO: This parameter doesn't exist, it's a remnant from the CMS package set root_path [parameter::get \ -package_id [ad_conn package_id] \ -parameter PageRoot] - + if { [string index $root_path 0] ne "/" } { # Relative path, prepend server_root set root_path "$::acs::pageroot/$root_path" } - + return [ns_normalizepath $root_path] - + } @@ -41,22 +41,22 @@ which should be a space-separated list of all the roots. Relative paths are relative to publish::get_page_root. The default is [list [publish::get_page_root]] - + @return A list of all the publish roots - + @see publish::get_template_root @see publish::get_page_root - + } { # LARS TODO: This parameter doesn't exist, it's a remnant from the CMS package set root_paths [parameter::get \ -package_id [ad_conn package_id] \ -parameter PublishRoots] - + if { [llength $root_paths] == 0 } { set root_paths [list [get_page_root]] } - + # Resolve relative paths set page_root [publish::get_page_root] set absolute_paths [list] @@ -67,19 +67,19 @@ lappend absolute_paths $path } } - + return $absolute_paths } ad_proc -public publish::mkdirs { path } { Create all the directories necessary to save the specified file - + @param path The path to the file that is about to be saved } { set index [string last "/" $path] if { $index != -1 } { file mkdir [string range $path 0 $index-1] - } + } } ############################################### @@ -90,25 +90,25 @@ ad_proc -private publish::push_id { item_id {revision_id ""}} { @private push_id - + Push an item id on top of stack. This proc is used to store state between child, relation and content tags. - - @param item_id + + @param item_id The id to be put on stack - - @param revision_id {default ""} + + @param revision_id {default ""} The id of the revision to use. If missing, live revision will most likely be used - - @see publish::pop_id + + @see publish::pop_id @see publish::get_main_item_id @see publish::get_main_revision_id } { - variable item_id_stack - variable revision_html + variable item_id_stack + variable revision_html if { [template::util::is_nil item_id] } { error "Null id pushed on stack in publish::push_id" @@ -121,7 +121,7 @@ if { [info exists ::content::item_id] } { set old_item_id $::content::item_id } - + if { [info exists ::content::revision_id] } { set old_revision_id $::content::revision_id } @@ -151,34 +151,33 @@ ad_proc -private publish::pop_id {} { @private pop_id - + Pop the item_id and the revision_id off the top of the stack. Clear the temporary item cache if the stack becomes empty. - + @return The popped item id, or the empty string if the string is already empty - - @see publish::push_id + + @see publish::push_id @see publish::get_main_item_id @see publish::get_main_revision_id } { - variable item_id_stack + variable item_id_stack set pair [lindex $item_id_stack 0] if { [template::util::is_nil pair] } { #error "Item id stack is empty in publish::pop_id" } - + set item_id_stack [lrange $item_id_stack 1 end] # If the stack is now empty, clear the cache if { [template::util::is_nil item_id_stack] } { array unset revision_html } - set ::content::item_id [lindex $pair 0] - set ::content::revision_id [lindex $pair 1] + lassign $pair ::content::item_id ::content::revision_id return $::content::item_id } @@ -187,14 +186,14 @@ ad_proc -public publish::proc_exists { namespace_name proc_name } { @public proc_exists - + Determine if a procedure exists in the given namespace - + @param namespace_name The fully qualified namespace name, such as "template::util" - + @param proc_name The proc name, such as "is_nil" - + @return 1 if the proc exists in the given namespace, 0 otherwise } { @@ -208,61 +207,61 @@ # -ad_proc -public publish::handle_binary_file { - item_id revision_id_ref url_ref error_ref args +ad_proc -public publish::handle_binary_file { + item_id revision_id_ref url_ref error_ref args } { @public handle_binary_file - + Helper procedure for writing handlers for binary files. It will write the blob of the item to the filesystem, but only if -embed is specified. Then, it will attempt to merge the image with its template.[ns_quotehtml $errmsg]
- include src=/foo/bar/baz item_id=item_id + include src=/foo/bar/baz item_id=item_id param=value param=value ...- + @param item_id The item id - + @param extra_args {} A list of extra parameters to be passed to the include tag, in form {name value name value ...} - + @return The HTML for the include tag - + @see content::item::get_virtual_path @see publish::html_args @@ -361,12 +360,12 @@ The basic image handler. Writes the image blob to the filesystem, then either merges with the template or provides a default - tag. Uses the title for alt text if no alt text is specified + tag. Uses the title for alt text if no alt text is specified externally. } { template::util::get_opts $args - + # LARS TODO: Added -no_merge, verify how this is supposed to work set html [publish::handle_binary_file \ $item_id revision_id url error_msg {*}$args -no_merge] @@ -405,36 +404,36 @@ } append html " $extra_html" - + # Append the alt text if needed if { !$have_alt } { append html " alt=\"$image_alt\"" } - + append html ">" return $html } -ad_proc -private publish::merge_with_template { item_id args } { +ad_proc -private publish::merge_with_template { item_id args } { @private merge_with_template - + Merge the item with its template and return the resulting HTML. This proc is similar to content::init - + @param item_id The item id - - @option revision_id {default The live revision} + + @option revision_id {default The live revision} The revision which is to be used when rendering the item - + @option html Extra HTML parameters to be passed to the ADP parser, in format {name value name value ...} - + @return The rendered HTML, or the empty string on failure - + @see publish::handle_item } { @@ -450,12 +449,12 @@ set revision_id [::content::item::get_live_revision -item_id $item_id] } - # Get the template + # Get the template set ::content::template_url [::content::item::get_template -item_id $item_id -use_context public] - if {$::content::template_url eq {}} { + if {$::content::template_url eq {}} { ns_log Warning "publish::merge_with_template: no template for item $item_id" - return "" + return "" } ns_log debug "publish::merge_with_template: template for item $item_id is $::content::template_url" @@ -479,9 +478,9 @@ return $html } - + ad_proc -public publish::handle::text { item_id args } { Return the text body of the item @@ -494,7 +493,7 @@ set revision_id [::content::item::get_live_revision -item_id $item_id] } else { set revision_id $opts(revision_id) - } + } if { [info exists opts(embed)] } { # Render the child item and embed it in the code @@ -508,7 +507,7 @@ # Query for values from a previous revision set html [db_string get_previous_content ""] } - } + } } else { # Just create an include tag @@ -519,9 +518,9 @@ } else { set extra_args "" } - + set html [publish::item_include_tag $item_id $extra_args] - } + } return $html } @@ -530,37 +529,36 @@ ad_proc -public publish::get_mime_handler { mime_type } { @public get_mime_handler - + Return the name of a proc that should be used to render items with the given mime-type. The mime type handlers should all follow the naming convention - +
proc publish::handle::mime_prefix::mime_suffix- + If the specific mime handler could not be found, get_mime_handler looks for a generic procedure with the name - +
proc publish::handle::mime_prefix- - If the generic mime handler does not exist either, + + If the generic mime handler does not exist either, get_mime_handler returns "" - - @param mime_type + + @param mime_type The full mime type, such as "text/html" or "image/jpg" - + @return The name of the proc which should be used to handle the mime-type, or an empty string on failure. - + @see publish::handle_item } { set mime_pair [split $mime_type "/"] - set mime_prefix [lindex $mime_pair 0] - set mime_suffix [lindex $mime_pair 1] + lassign $mime_pair mime_prefix mime_suffix # Look for the specific handler if { [proc_exists "::publish::handle::${mime_prefix}" $mime_suffix] } { @@ -580,13 +578,13 @@ ad_proc -private publish::get_main_item_id {} { @private get_main_item_id - + Get the main item id from the top of the stack - + @return the main item id - - @see publish::pop_id - @see publish::push_id + + @see publish::pop_id + @see publish::push_id @see publish::get_main_revision_id } { @@ -604,13 +602,13 @@ ad_proc -private publish::get_main_revision_id {} { @private get_main_revision_id - + Get the main item revision from the top of the stack - + @return the main item id - - @see publish::pop_id - @see publish::push_id + + @see publish::pop_id + @see publish::push_id @see publish::get_main_item_id } { @@ -630,27 +628,27 @@ @private handle_item Render an item either by looking it up in the temporary cache, - or by using the appropriate mime handler. Once the item is rendered, it + or by using the appropriate mime handler. Once the item is rendered, it is stored in the temporary cache under a key which combines the item_id, any extra HTML parameters, and a flag which specifies whether the item was merged with its template.
[ns_quotehtml $error]
insert into lang_testsort values ('lama'); insert into lang_testsort values ('lhasa'); insert into lang_testsort values ('llama'); - insert into lang_testsort values ('lzim'); + insert into lang_testsort values ('lzim');@author Jeff Davis (davis@xarg.net) @param field Name of Oracle column - @param locale Locale for sorting. + @param locale Locale for sorting. If locale is unspecified just return the column name @return Language aware version of field for Oracle ORDER BY clause. } { - # Use west european for english since I think that will fold + # Use west european for english since I think that will fold # cedilla etc into reasonable values... set lang(en) "XWest_european" set lang(de) "XGerman_din" - set lang(fr) "XFrench" - set lang(es) "XSpanish" - + set lang(fr) "XFrench" + set lang(es) "XSpanish" + if { $locale eq "" || ![info exists lang($locale)] } { return $field - } else { + } else { return "NLSSORT($field,'NLS_SORT = $lang($locale)')" } } ad_proc -private lang::util::get_hash_indices { multilingual_string } { - Returns a list of two element lists containing + Returns a list of two element lists containing the start and end indices of a #message_key# match in the multilingual string. This proc is used by the localize proc. @@ -88,15 +88,15 @@ Given the contents of an adp file return the indices of the start and end chars of embedded message keys on the syntax: - <#package_key.message_key Some en_US text#> + <#package_key.message_key Some en_US text#> - @author Peter marklund (peter@collaboraid.biz) + @author Peter marklund (peter@collaboraid.biz) } { return [lang::util::get_regexp_indices $adp_file_string [message_tag_regexp]] } - + ad_proc -private lang::util::get_regexp_indices { multilingual_string regexp_pattern } { - Returns a list of two element lists containing + Returns a list of two element lists containing the start and end indices of what is captured by the first parenthesis in the given regexp pattern in the multilingual string. The regexp pattern must follow the syntax of the expression argument to the Tcl regexp command. @@ -112,33 +112,32 @@ set offset_string $multilingual_string set indices_list {} - while { [regexp -indices $regexp_pattern $offset_string full_match_idx key_match_idx] } { - - set start_idx [lindex $key_match_idx 0] - set end_idx [lindex $key_match_idx 1] + while { [regexp -indices $regexp_pattern $offset_string full_match_idx key_match_idx] } { + lassign $key_match_idx start_idx end_idx + lappend indices_list [list [expr {$multilingual_string_offset + $start_idx}] \ [expr {$multilingual_string_offset + $end_idx}]] - + set new_offset [expr {$end_idx + 1}] set multilingual_string_offset [expr {$multilingual_string_offset + $new_offset}] set offset_string [string range $offset_string $new_offset end] } - + return $indices_list -} +} -ad_proc lang::util::replace_temporary_tags_with_lookups { - file_list +ad_proc lang::util::replace_temporary_tags_with_lookups { + file_list } { Modify the given ADP or Tcl files by replacing occurencies of message keys with message lookups (i.e. #package_key.message_key# for ADP files and [_ "package_key.message_key"] for Tcl files) and create entries in the catalog file for each of these keys. If the short hand form <#_ Some en_US text#> is used then the key will be autogenerated based on the text. Returns the number of replacements done. This procedure only - reads from and writes to the catalog file specified (the en_US catalog - file per default) of the package that the files belong to, the database + reads from and writes to the catalog file specified (the en_US catalog + file per default) of the package that the files belong to, the database is not accessed in any way. @param file_list A list of paths to adp or Tcl files to do replacements in. The @@ -154,21 +153,21 @@ } # Get package_key - set first_file [lindex $file_list 0] + set first_file [lindex $file_list 0] if { ![regexp {/?packages/([^/]+)/} $first_file match package_key] } { error "lang::util::replace_temporary_tags_with_lookups: Could not extract package_key from file $first_file" } # Always create new keys in en_US set locale "en_US" - + # Read messages from any existing catalog file set catalog_file_path [lang::catalog::get_catalog_file_path \ -package_key $package_key \ -locale $locale] if { [file exists $catalog_file_path] } { set catalog_file_contents [lang::catalog::read_file $catalog_file_path] - array set catalog_array [lang::catalog::parse $catalog_file_contents] + array set catalog_array [lang::catalog::parse $catalog_file_contents] array set messages_array $catalog_array(messages) } else { array set messages_array {} @@ -178,7 +177,7 @@ set number_of_replacements "0" # Loop over and process each file - foreach file $file_list { + foreach file $file_list { ns_log debug "lang::util::replace_temporary_tags_with_lookups: processing file $file" set full_file_path "$::acs::rootdir/$file" @@ -201,10 +200,9 @@ incr number_of_replacements - set tag_start_idx [lindex $index_pair 0] - set tag_end_idx [lindex $index_pair 1] + lassign $index_pair tag_start_idx tag_end_idx set message_tag "[string range $file_contents $tag_start_idx $tag_end_idx]" - + # Extract the message key and the text from the message tag # The regexp on the message tag string should never fail as the message tag # was extracted with a known regexp @@ -235,7 +233,7 @@ if { [info exists messages_array($unique_key)] } { # The key already exists - + if {$messages_array($unique_key) eq $new_text} { # New and old texts are identical - don't add the key ns_log Notice [list lang::util::replace_temporary_tags_with_lookups - \ @@ -262,14 +260,14 @@ } else { ns_log Notice [list lang::util::replace_temporary_tags_with_lookups - Will be adding \ new key $unique_key to catalog file for package $package_key] - } + } set messages_array($unique_key) $new_text # We are done break } - + incr key_comp_counter } @@ -280,7 +278,7 @@ $modified_file_contents \ "#${package_key}.${unique_key}#" \ modified_file_contents - } + } {^tcl$} { regsub [message_tag_regexp] \ $modified_file_contents \ @@ -311,7 +309,7 @@ } return $number_of_replacements -} +} ad_proc -public lang::util::localize { string_with_hashes @@ -330,12 +328,12 @@ return $string_with_hashes } - if {$locale eq ""} { - set locale [ad_conn locale] - } + if {$locale eq ""} { + set locale [ad_conn locale] + } set indices_list [get_hash_indices $string_with_hashes] - + set subst_string "" set start_idx 0 foreach item_idx $indices_list { @@ -346,23 +344,23 @@ # Attempt a message lookup set message_value [lang::message::lookup $locale $message_key "" "" 2] - + # Replace the string # LARS: We don't use regsub here, because regsub interprets certain characters # in the replacement string specially. append subst_string [string range $string_with_hashes $start_idx [lindex $item_idx 0]-1] append subst_string $message_value set start_idx [expr {[lindex $item_idx 1] + 1}] - } + } append subst_string [string range $string_with_hashes $start_idx end] - + return $subst_string } -ad_proc -public lang::util::charset_for_locale { - locale +ad_proc -public lang::util::charset_for_locale { + locale } { Returns the MIME charset name corresponding to a locale. @@ -376,25 +374,25 @@ set $key [db_string -cache_key ad_lang_mime_charset_$locale charset_for_locale {}] } -ad_proc -private lang::util::default_locale_from_lang_not_cached { +ad_proc -private lang::util::default_locale_from_lang_not_cached { language } { Returns the default locale for a language. Not cached. - + @author Henry Minsky (hqm@mit.edu) @param language Name of a language, using a two or three letter ISO code @return Default locale - + @see lang::util::default_locale_from_lang } { # LARS: # Note that this query does not use bind variables, because these cause the query to not - # match any rows in Oracle when the language key is less than 3 characters, + # match any rows in Oracle when the language key is less than 3 characters, # because the column is a char(3), not a varchar2(3). return [db_string default_locale_from_lang {} -default ""] } -ad_proc -public lang::util::default_locale_from_lang { +ad_proc -public lang::util::default_locale_from_lang { language } { Returns an enabled default locale for a language. If a language @@ -408,8 +406,8 @@ return [util_memoize [list lang::util::default_locale_from_lang_not_cached $language]] } -ad_proc -public lang::util::nls_language_from_language { - language +ad_proc -public lang::util::nls_language_from_language { + language } { Returns the nls_language name for a language @@ -437,14 +435,14 @@ Suggest a key for given text. } { regsub -all " " $text "_" key - + # Do not allow . in the key as dot is used as a separator to qualify a key # with the package key. The prepending with package key is done at a later # stage regsub -all {[^-a-zA-Z0-9_]} $key "" key - + # is this key too long? - + if { [string length $key] > 20 } { set key "lt_[string range $key 0 20]" } @@ -466,7 +464,7 @@ while {[regsub -all [template::adp_variable_regexp] $text {\1%\2%} text]} {} while {[regsub -all [template::adp_variable_regexp_noquote] $text {\1%\2;noquote%} text]} {} - return $text + return $text } ad_proc -private lang::util::convert_percentage_signs_to_adp_variables { text } { @@ -492,11 +490,11 @@ return $text } -ad_proc -public lang::util::replace_adp_text_with_message_tags { +ad_proc -public lang::util::replace_adp_text_with_message_tags { file_name mode {keys {}} - + } { Prepares an .adp-file for localization by inserting temporary hash-tags around text strings that looks like unlocalized plain text. Needless to say @@ -526,7 +524,7 @@ @author Jeff Davis } { - set state text + set state text set out {} set report {} @@ -542,14 +540,14 @@ #ns_write "input== s=[string range $s 0 600]\n" set x {} - while {$s ne "" && $n < 1000} { - if { $state eq "text" } { + while {$s ne "" && $n < 1000} { + if { $state eq "text" } { # clip non tag stuff - if {![regexp {(^[^<]*?)(<.*)$} $s match text s x]} { + if {![regexp {(^[^<]*?)(<.*)$} $s match text s x]} { set text $s set s {} - } + } # Remove parts from the text that we know are not translatable # such as adp variables, message key lookups, and @@ -572,14 +570,14 @@ if { $mode eq "report" } { # create a key for the text - + set key [suggest_key $text] lappend report [list $key "
[string range [remove_gt_lt $out$lead] end-20 end]$text[string range [remove_gt_lt $lag$s] 0 20]
" ]
- } else {
+ } else {
# Write mode
if { [llength $keys] != 0} {
- # Use keys supplied
+ # Use keys supplied
if { [lindex $keys $n] ne "" } {
# Use supplied key
set write_key [lindex $keys $n]
@@ -589,7 +587,7 @@
}
} else {
# No keys supplied - autogenerate a key
- set write_key [suggest_key $text]
+ set write_key [suggest_key $text]
}
if { $write_key ne "" } {
@@ -601,12 +599,12 @@
# Leave the text untouched
lappend garbage "[string range [remove_gt_lt $out$lead] end-20 end]$text [string range [remove_gt_lt $lag$s] 0 20]
"
append out "$lead$text$lag"
- }
+ }
}
incr n
- } else {
+ } else {
# this was not something we should localize
append out $text
@@ -620,18 +618,18 @@
regsub -all "\n" $text "" short_text
set short_text [string range $short_text 0 40]
-
+
lappend garbage "$short_text
"
}
}
- set state tag
+ set state tag
- } elseif { $state eq "tag"} {
- if {![regexp {(^<[^>]*?>)(.*)$} $s match tag s]} {
+ } elseif { $state eq "tag"} {
+ if {![regexp {(^<[^>]*?>)(.*)$} $s match tag s]} {
set s {}
- }
+ }
append out $tag
set state text
@@ -643,7 +641,7 @@
# backup original file - fail silently if backup already exists
if { [catch {file copy -- $file_name $file_name.orig}] } { }
-
+
set fp [open $file_name "w"]
puts $fp $out
close $fp
@@ -655,10 +653,10 @@
ad_proc -public lang::util::translator_mode_p {} {
Whether translator mode is enabled for this session or
- not. Translator mode will cause all non-translated messages to appear as a
+ not. Translator mode will cause all non-translated messages to appear as a
link to a page where the message can be translated, instead of the default
"not translated" message.
-
+
@author Lars Pind (lars@collaboraid.biz)
@creation-date October 24, 2002
@@ -790,14 +788,14 @@
} else {
set message_key "${prefix}_[lang::util::suggest_key $text]"
}
- }
-
+ }
+
# Register the language keys
lang::message::register en_US $package_key $message_key $text
if {$locale ne ""} {
lang::message::register $locale $package_key $message_key $text
}
-
+
return "#${package_key}.${message_key}#"
} else {
return "$text"
@@ -850,7 +848,7 @@
return $edit_url
}
-ad_proc -public lang::util::iso6392_from_language {
+ad_proc -public lang::util::iso6392_from_language {
-language:required
} {
@@ -871,14 +869,14 @@
} elseif { $lang_len eq 3 } {
# input is iso-639-2 language code
# we check in the table in case the language code is wrong
-
+
set iso6392_code [db_string get_iso2_code_from_iso2 {} -default ""]
}
return $iso6392_code
}
-ad_proc -public lang::util::iso6392_from_locale {
+ad_proc -public lang::util::iso6392_from_locale {
-locale:required
} {
@@ -894,7 +892,7 @@
return [lang::util::iso6392_from_language -language $language]
}
-ad_proc -public lang::util::language_label {
+ad_proc -public lang::util::language_label {
-language:required
} {
@@ -915,7 +913,7 @@
} elseif { $lang_len eq 3 } {
# input is iso-639-2 language code
# we check in the table in case the language code is wrong
-
+
set lang_label [db_string get_label_from_iso2 {} -default ""]
}
Index: openacs-4/packages/acs-lang/www/admin/lookup.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/lookup.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-lang/www/admin/lookup.tcl 7 Aug 2017 23:47:57 -0000 1.3
+++ openacs-4/packages/acs-lang/www/admin/lookup.tcl 8 May 2018 22:37:18 -0000 1.4
@@ -13,11 +13,11 @@
{help_text "[_ acs-lang.Include_package_key_as]"}
{html {size 50}}
}
- {locale:text
+ {locale:text
{label "[_ acs-lang.Locale]"}
{help_text "[_ acs-lang.Can_be_two_character]"}
}
-} -on_submit {
+} -on_submit {
if {[catch {
# No substitution
set message [lang::message::lookup $locale $key]
@@ -26,10 +26,9 @@
ad_log error $errmsg
ad_script_abort
}
-
+
set keyv [split $key "."]
- set package_key [lindex $keyv 0]
- set message_key [lindex $keyv 1]
+ lassign $keyv package_key message_key
set edit_url [export_vars -base edit-localized-message { package_key locale message_key {return_url [ad_return_url]} }]
Index: openacs-4/packages/acs-mail-lite/tcl/imap-inbound-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/tcl/imap-inbound-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-mail-lite/tcl/imap-inbound-procs.tcl 20 Feb 2018 09:07:27 -0000 1.4
+++ openacs-4/packages/acs-mail-lite/tcl/imap-inbound-procs.tcl 8 May 2018 22:37:18 -0000 1.5
@@ -72,9 +72,7 @@
Quote mailbox with curly braces like: {{mailbox.host}mailbox.name} "
set mb_list [acs_mail_lite::imap_mailbox_split $mb]
if { [llength $mb_list] eq 3 } {
- set ho [lindex $mb_list 0]
- set na [lindex $mb_list 1]
- set ssl_p [lindex $mb_list 2]
+ lassign $mb_list ho na ssl_p
ns_log Notice "acs_mail_lite::imap_conn_set.479: \
Used alternate parsing. host '${ho}' mailbox.name '${na}' ssl_p '${ssl_p}'"
} else {
@@ -251,9 +249,7 @@
set id [lindex $s_list 0]
if { $id eq $conn_id } {
set prior_conn_exists_p 1
- set opentime [lindex $s_list 1]
- set accesstime [lindex $s_list 2]
- set mailbox [lindex $s_list 3]
+ lassign $s_list . opentime accesstime mailbox
}
incr i
}
Index: openacs-4/packages/acs-subsite/tcl/package-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/package-procs.tcl,v
diff -u -r1.33 -r1.34
--- openacs-4/packages/acs-subsite/tcl/package-procs.tcl 25 Apr 2018 19:23:26 -0000 1.33
+++ openacs-4/packages/acs-subsite/tcl/package-procs.tcl 8 May 2018 22:37:18 -0000 1.34
@@ -473,9 +473,7 @@
set primary_keys [list "${table_name}.${id_column}"]
foreach row [package_object_attribute_list -start_with $start_with $object_type] {
- set table [lindex $row 1]
- set column [lindex $row 2]
- set object_column [lindex $row 8]
+ lassign $row . table column . . . . . object_column
if {[string tolower $column] eq "object_id"} {
# We already have object_id... skip this column
Index: openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/Attic/00-database-procs.tcl,v
diff -u -r1.98 -r1.99
--- openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl 25 Apr 2018 19:23:26 -0000 1.98
+++ openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl 8 May 2018 22:37:18 -0000 1.99
@@ -1365,8 +1365,7 @@
} {
return -code error "Expected if_no_rows as second-to-last argument"
}
- set code_block [lindex $args 0]
- set if_no_rows_code_block [lindex $args 2]
+ lassign $args code_block . if_no_rows_code_block
} else {
return -code error "Expected 1 or 3 arguments after switches"
}
@@ -1760,8 +1759,7 @@
} {
return -code error "Expected if_no_rows as second-to-last argument"
}
- set code_block [lindex $args 0]
- set if_no_rows_code_block [lindex $args 2]
+ lassign $args code_block . if_no_rows_code_block
} else {
return -code error "Expected 1 or 3 arguments after switches"
}
Index: openacs-4/packages/acs-tcl/tcl/pools-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/pools-init.tcl,v
diff -u -r1.7 -r1.8
--- openacs-4/packages/acs-tcl/tcl/pools-init.tcl 7 Aug 2017 23:47:59 -0000 1.7
+++ openacs-4/packages/acs-tcl/tcl/pools-init.tcl 8 May 2018 22:37:18 -0000 1.8
@@ -1,50 +1,49 @@
if {[ns_info version] eq "4.5"} {
set cfgsection "ns/server/[ns_info server]"
-
+
set minthreads [ns_config $cfgsection minthreads 5]
set maxthreads [ns_config $cfgsection maxthreads 10]
- set maxconns [ns_config $cfgsection maxconnections 100]
- set timeout [ns_config $cfgsection threadtimeout 120]
+ set maxconns [ns_config $cfgsection maxconnections 100]
+ set timeout [ns_config $cfgsection threadtimeout 120]
ns_pools set default -minthreads $minthreads -maxthreads $maxthreads -maxconns $maxconns -timeout $timeout
-
+
ns_log Notice "Default Pool: [ns_pools get default]"
-
+
# Setup optional threadpools
-
+
set poolSection $cfgsection/pools
-
+
set poolSet [ns_configsection $poolSection]
-
+
if {"$poolSet" ne ""} {
-
- set poolSize [ns_set size $poolSet]
- for {set i 0} {$i < $poolSize} {incr i} {
- set poolName [ns_set key $poolSet $i]
- set poolDescription [ns_set value $poolSet $i]
- set poolConfigSection "ns/server/[ns_info server]/pool/$poolName"
- set poolConfigSet [ns_configsection $poolConfigSection]
- if {"$poolConfigSet" eq ""} {
- continue
- }
- set poolMinthreads [ns_config $poolConfigSection minthreads $minthreads]
- set poolMaxthreads [ns_config $poolConfigSection maxthreads $maxthreads]
- set poolMaxconns [ns_config $poolConfigSection maxconnections $maxconns]
- set poolTimeout [ns_config $poolConfigSection threadtimeout $timeout]
-
- ns_pools set $poolName -minthreads $poolMinthreads -maxthreads $poolMaxthreads -maxconns $poolMaxconns -timeout $poolTimeout
- ns_log Notice "$poolName Pool: [ns_pools get $poolName]"
- set poolConfigSize [ns_set size $poolConfigSet]
- for {set j 0} {$j < $poolConfigSize} {incr j} {
- if {[string tolower [ns_set key $poolConfigSet $j]] eq "map"} &
- #123;
- set mapList [split [ns_set value $poolConfigSet $j]]
- set poolMethod [lindex $mapList 0]
- set poolPattern [lindex $mapList 1]
- ns_pools register $poolName [ns_info server] $poolMethod $poolPattern
- ns_log Notice "ns_pools registered $poolName [ns_info server] $poolMethod $poolPattern"
- }
- }
+
+ set poolSize [ns_set size $poolSet]
+ for {set i 0} {$i < $poolSize} {incr i} {
+ set poolName [ns_set key $poolSet $i]
+ set poolDescription [ns_set value $poolSet $i]
+ set poolConfigSection "ns/server/[ns_info server]/pool/$poolName"
+ set poolConfigSet [ns_configsection $poolConfigSection]
+ if {"$poolConfigSet" eq ""} {
+ continue
+ }
+ set poolMinthreads [ns_config $poolConfigSection minthreads $minthreads]
+ set poolMaxthreads [ns_config $poolConfigSection maxthreads $maxthreads]
+ set poolMaxconns [ns_config $poolConfigSection maxconnections $maxconns]
+ set poolTimeout [ns_config $poolConfigSection threadtimeout $timeout]
+
+ ns_pools set $poolName -minthreads $poolMinthreads -maxthreads $poolMaxthreads -maxconns $poolMaxconns -timeout $poolTimeout
+ ns_log Notice "$poolName Pool: [ns_pools get $poolName]"
+ set poolConfigSize [ns_set size $poolConfigSet]
+ for {set j 0} {$j < $poolConfigSize} {incr j} {
+ if {[string tolower [ns_set key $poolConfigSet $j]] eq "map"} &
+ #123;
+ set mapList [split [ns_set value $poolConfigSet $j]]
+ lassign $mapList poolMethod poolPattern
+ ns_pools register $poolName [ns_info server] $poolMethod $poolPattern
+ ns_log Notice "ns_pools registered $poolName [ns_info server] $poolMethod $poolPattern"
+ }
+ }
}
}