Index: openacs-4/packages/acs-tcl/acs-tcl.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/acs-tcl.info,v
diff -u -N -r1.67.2.6 -r1.67.2.7
--- openacs-4/packages/acs-tcl/acs-tcl.info 8 Sep 2013 09:45:57 -0000 1.67.2.6
+++ openacs-4/packages/acs-tcl/acs-tcl.info 2 Oct 2013 22:55:54 -0000 1.67.2.7
@@ -7,7 +7,7 @@
t
t
-
+
OpenACS
The Kernel Tcl API library.
2013-09-08
@@ -18,7 +18,7 @@
GPL version 2
3
-
+
Index: openacs-4/packages/acs-tcl/lib/page-error.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/lib/page-error.tcl,v
diff -u -N -r1.7 -r1.7.6.1
--- openacs-4/packages/acs-tcl/lib/page-error.tcl 12 Jul 2009 01:08:30 -0000 1.7
+++ openacs-4/packages/acs-tcl/lib/page-error.tcl 2 Oct 2013 22:55:54 -0000 1.7.6.1
@@ -373,7 +373,7 @@
}
# Add empty option to resolution code
if { $enabled_action_id ne "" } {
- if { [lsearch [workflow::action::get_element -action_id $action_id -element edit_fields] "resolution"] == -1 } {
+ if {"resolution" ni [workflow::action::get_element -action_id $action_id -element edit_fields]} {
element set_properties bug_edit resolution -options [concat {{{} {}}} [element get_property bug_edit resolution options]]
}
} else {
Index: openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl,v
diff -u -N -r1.86.2.7 -r1.86.2.8
--- openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl 29 Sep 2013 20:24:02 -0000 1.86.2.7
+++ openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl 2 Oct 2013 22:55:54 -0000 1.86.2.8
@@ -709,14 +709,13 @@
if {[regexp -nocase -- {^\s*select} $test_sql match]} {
# ns_log Debug "PLPGSQL: bypassed anon function"
set selection [db_exec 0or1row $db $full_statement_name $sql]
- } elseif {[regexp -nocase -- {^\s*create table} $test_sql match] || [regexp -nocase -- {^\s*drop table} $test_sql match]} {
+ } elseif {[regexp -nocase -- {^\s*(create|drop) table} $test_sql match]} {
ns_log Debug "PLPGSQL: bypassed anon function for create/drop table"
set selection [db_exec dml $db $full_statement_name $sql]
return ""
} else {
# ns_log Debug "PLPGSQL: using anonymous function"
- set selection [db_exec_plpgsql $db $full_statement_name $sql \
- $statement_name]
+ set selection [db_exec_plpgsql $db $full_statement_name $sql $statement_name]
}
return [ns_set value $selection 0]
}
@@ -929,8 +928,9 @@
set db [lindex $db_state(handles) $index_to_examine]
# Stop now if the handle is part of a transaction.
- if { [info exists db_state(transaction_level,$db)] && \
- $db_state(transaction_level,$db) > 0 } {
+ if { [info exists db_state(transaction_level,$db)]
+ && $db_state(transaction_level,$db) > 0
+ } {
break
}
@@ -1321,7 +1321,9 @@
set code_block [lindex $args 0]
} elseif { $arglength == 3 } {
# Should have code block + if_no_rows + code block.
- if { [lindex $args 1] ne "if_no_rows" && [lindex $args 1] ne "else" } {
+ if { [lindex $args 1] ne "if_no_rows"
+ && [lindex $args 1] ne "else"
+ } {
return -code error "Expected if_no_rows as second-to-last argument"
}
set code_block [lindex $args 0]
@@ -1714,8 +1716,9 @@
set code_block [lindex $args 0]
} elseif { $arglength == 3 } {
# Should have code block + if_no_rows + code block.
- if { [lindex $args 1] ne "if_no_rows" \
- && [lindex $args 1] ne "else" } {
+ if { [lindex $args 1] ne "if_no_rows"
+ && [lindex $args 1] ne "else"
+ } {
return -code error "Expected if_no_rows as second-to-last argument"
}
set code_block [lindex $args 0]
@@ -1727,8 +1730,10 @@
upvar $level_up "$var_name:rowcount" counter
upvar $level_up "$var_name:columns" columns
- if { [info exists cache_key] && $append_p &&
- [info exists counter] && $counter > 0 } {
+ if { [info exists cache_key]
+ && $append_p
+ && [info exists counter] && $counter > 0
+ } {
return -code error "Can't append and cache a non-empty multirow datasource simultaneously"
}
@@ -2540,7 +2545,9 @@
# maintainer we shouldn't break existing code over such trivialities...
# GN: windows requires $pghost "-h ..."
- if { ([db_get_dbhost] eq "localhost" || [db_get_dbhost] eq "") && $::tcl_platform(platform) ne "windows" } {
+ if { ([db_get_dbhost] eq "localhost" || [db_get_dbhost] eq "")
+ && $::tcl_platform(platform) ne "windows"
+ } {
set pghost ""
} else {
set pghost "-h [db_get_dbhost]"
Index: openacs-4/packages/acs-tcl/tcl/adp-parser-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/adp-parser-procs.tcl,v
diff -u -N -r1.2.10.3 -r1.2.10.4
--- openacs-4/packages/acs-tcl/tcl/adp-parser-procs.tcl 30 Sep 2013 09:38:18 -0000 1.2.10.3
+++ openacs-4/packages/acs-tcl/tcl/adp-parser-procs.tcl 2 Oct 2013 22:55:54 -0000 1.2.10.4
@@ -244,7 +244,9 @@
if { [string index $adp $index] eq "/" } {
set end_tag_p 1
incr index
- } elseif { ![info exists literal_tag] && [string index $adp $index] eq "%" } {
+ } elseif { ![info exists literal_tag]
+ && [string index $adp $index] eq "%"
+ } {
doc_adp_flush_text_buffer
incr index
@@ -256,8 +258,9 @@
}
set tcl_code_begin $index
- while { $index < [string length $adp] && \
- ([string index $adp $index] ne "%" || [string index $adp $index+1] ne ">") } {
+ while { $index < [string length $adp]
+ && ([string index $adp $index] ne "%" || [string index $adp $index+1] ne ">")
+ } {
incr index
}
if { $index >= [string length $adp] } {
@@ -286,15 +289,17 @@
if { ![info exists tag] } {
# Find the next non-word character.
set tag_begin $index
- while { [string index $adp $index] eq "-" || \
- [string is wordchar -strict [string index $adp $index]] } {
+ while { [string index $adp $index] eq "-"
+ || [string is wordchar -strict [string index $adp $index]]
+ } {
incr index
}
set tag [string range $adp $tag_begin $index-1]
}
- if { (![info exists literal_tag] || ($end_tag_p && $tag eq $literal_tag)) && \
- [nsv_exists doc_adptags $tag] } {
+ if { (![info exists literal_tag] || ($end_tag_p && $tag eq $literal_tag))
+ && [nsv_exists doc_adptags $tag]
+ } {
doc_adp_flush_text_buffer
if { [info exists literal_tag] } {
@@ -321,10 +326,11 @@
# Not a > - must be an attribute name.
set attr_name_begin $index
- while { $index < $adp_length && \
- [string index $adp $index] ne ">" && \
- [string index $adp $index] ne "=" && \
- ![string is space -strict [string index $adp $index]] } {
+ while { $index < $adp_length
+ && [string index $adp $index] ne ">"
+ && [string index $adp $index] ne "="
+ && ![string is space -strict [string index $adp $index]]
+ } {
incr index
}
if { $attr_name_begin eq $index } {
@@ -348,10 +354,11 @@
incr index
} else {
set value_begin $index
- while { $index < $adp_length && \
- [string index $adp $index] ne ">" && \
- [string index $adp $index] ne "=" && \
- ![string is space -strict [string index $adp $index]] } {
+ while { $index < $adp_length
+ && [string index $adp $index] ne ">"
+ && [string index $adp $index] ne "="
+ && ![string is space -strict [string index $adp $index]]
+ } {
incr index
}
set value_end $index
Index: openacs-4/packages/acs-tcl/tcl/apm-file-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-file-procs.tcl,v
diff -u -N -r1.35.8.8 -r1.35.8.9
--- openacs-4/packages/acs-tcl/tcl/apm-file-procs.tcl 30 Sep 2013 12:00:40 -0000 1.35.8.8
+++ openacs-4/packages/acs-tcl/tcl/apm-file-procs.tcl 2 Oct 2013 22:55:54 -0000 1.35.8.9
@@ -375,7 +375,7 @@
# I would like to add test_procs to the list but currently test_procs files are used to register test cases
# and we don't want to resource these files in every interpreter. Test procs should be defined in test_init files.
set watchable_file_types [list tcl_procs query_file test_procs]
- set right_file_type_p [expr {[lsearch -exact $watchable_file_types $file_type] != -1}]
+ set right_file_type_p [expr {$file_type in $watchable_file_types}]
# Both db type and file type must be right
set watchable_p [expr {$right_db_type_p && $right_file_type_p}]
Index: openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl,v
diff -u -N -r1.108.2.8 -r1.108.2.9
--- openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 29 Sep 2013 14:55:32 -0000 1.108.2.8
+++ openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 2 Oct 2013 22:55:54 -0000 1.108.2.9
@@ -261,8 +261,9 @@
foreach spec_file $spec_files {
if { [catch {
array set package [apm_read_package_info_file $spec_file]
- if { ($package(initial-install-p) eq "t" || !$initial_install_p) && \
- [apm_package_supports_rdbms_p -package_key $package(package.key)] } {
+ if { ($package(initial-install-p) eq "t" || !$initial_install_p)
+ && [apm_package_supports_rdbms_p -package_key $package(package.key)]
+ } {
lappend install_pend [pkg_info_new \
$package(package.key) \
$spec_file \
@@ -356,9 +357,10 @@
set counter 0
foreach pkg_info_add $pkg_info_all {
# Will this package do anything to change whether this requirement has been satisfied?
- if { [pkg_info_key $pkg_info_add] eq [lindex $req 0] &&
- [apm_dependency_provided_p -dependency_list [pkg_info_provides $pkg_info_add] \
- [lindex $req 0] [lindex $req 1]] == 1 } {
+ if { [pkg_info_key $pkg_info_add] eq [lindex $req 0]
+ && [apm_dependency_provided_p -dependency_list [pkg_info_provides $pkg_info_add] \
+ [lindex $req 0] [lindex $req 1]] == 1
+ } {
# It sure does. Add it to list of packages to install
lappend install_pend $pkg_info_add
@@ -538,8 +540,9 @@
}
# If what we provide is required, and the required version is less than what we provide,
# drop the requirement
- if { [info exists required($prov_uri)] && \
- [apm_version_names_compare $required($prov_uri) $prov_version] <= 0 } {
+ if { [info exists required($prov_uri)]
+ && [apm_version_names_compare $required($prov_uri) $prov_version] <= 0
+ } {
array unset required($prov_uri)
}
}
@@ -578,9 +581,9 @@
set prov_uri [lindex $prov 0]
set prov_version [lindex $prov 1]
- if { [info exists required($prov_uri)] && \
- [apm_version_names_compare $required($prov_uri) $prov_version] <= 0 } {
-
+ if { [info exists required($prov_uri)]
+ && [apm_version_names_compare $required($prov_uri) $prov_version] <= 0
+ } {
ns_log Debug "apm_dependency_check_new: Adding $package_key, as it provides $prov_uri $prov_version"
# If this package provides something that's required in a version high enough
@@ -685,7 +688,8 @@
}
if { [apm_package_supports_rdbms_p -package_key $package(package.key)]
- && ![apm_package_installed_p $package(package.key)] } {
+ && ![apm_package_installed_p $package(package.key)]
+ } {
lappend install_spec_files $install_spec_file
}
}
@@ -701,7 +705,8 @@
}
if { [apm_package_supports_rdbms_p -package_key $package(package.key)]
- && ![apm_package_installed_p $package(package.key)] } {
+ && ![apm_package_installed_p $package(package.key)]
+ } {
# Save the package info, we may need it for dependency
# satisfaction later
lappend pkg_info_list [pkg_info_new $package(package.key) \
@@ -1707,8 +1712,9 @@
set f2 [lindex [split $f2 /] end]
# Get the version number from, e.g. the 2.0 from upgrade-2.0-3.0.sql
- if {[regexp {\-(.*)-.*.sql} $f1 match f1_version_from] &&
- [regexp {\-(.*)-.*.sql} $f2 match f2_version_from]} {
+ if {[regexp {\-(.*)-.*.sql} $f1 match f1_version_from]
+ && [regexp {\-(.*)-.*.sql} $f2 match f2_version_from]
+ } {
# At this point we should have something like 2.0 and 3.1d which Tcl string
# comparison can handle.
set f1_version_from [db_exec_plsql test_f1 {}]
@@ -1795,8 +1801,9 @@
# is defined, which we interpret to mean a file containing queries that work with all of our
# supported databases.
- if {"query_file" eq $file_type &&
- ($file_db_type eq "" || [db_type] eq $file_db_type )} {
+ if {"query_file" eq $file_type
+ && ($file_db_type eq "" || [db_type] eq $file_db_type )
+ } {
ns_log Debug "apm_query_files_find: Adding $path to the list of query files."
lappend query_file_list $path
}
@@ -1995,9 +2002,10 @@
# Check that
# from_version_name < elm_from < elm_to < to_version_name
- if { [apm_version_names_compare $from_version_name $elm_from] <= 0 && \
- [apm_version_names_compare $elm_from $elm_to] <= 0 && \
- [apm_version_names_compare $elm_to $to_version_name] <= 0 } {
+ if { [apm_version_names_compare $from_version_name $elm_from] <= 0
+ && [apm_version_names_compare $elm_from $elm_to] <= 0
+ && [apm_version_names_compare $elm_to $to_version_name] <= 0
+ } {
set chunks($elm_from,$elm_to) $elm_chunk
}
}
Index: openacs-4/packages/acs-tcl/tcl/apm-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-procs.tcl,v
diff -u -N -r1.94.2.6 -r1.94.2.7
--- openacs-4/packages/acs-tcl/tcl/apm-procs.tcl 2 Oct 2013 07:44:14 -0000 1.94.2.6
+++ openacs-4/packages/acs-tcl/tcl/apm-procs.tcl 2 Oct 2013 22:55:55 -0000 1.94.2.7
@@ -482,8 +482,9 @@
set full_path "[acs_package_root_dir $package_key]/$file"
# If $file had a different mtime when it was last loaded, return
# needs_reload. (If the file should exist but doesn't, just skip it.)
- if { [file exists $full_path] &&
- [file mtime $full_path] != [nsv_get apm_library_mtime "packages/$package_key/$file"] } {
+ if { [file exists $full_path]
+ && [file mtime $full_path] ne [nsv_get apm_library_mtime "packages/$package_key/$file"]
+ } {
return "needs_reload"
}
}
@@ -498,8 +499,9 @@
set full_path "[acs_package_root_dir $package_key]/$file"
# If $file had a different mtime when it was last loaded, return
# needs_reload. (If the file should exist but doesn't, just skip it.)
- if { [file exists $full_path] &&
- [file mtime $full_path] != [nsv_get apm_library_mtime "packages/$package_key/$file"] } {
+ if { [file exists $full_path]
+ && [file mtime $full_path] ne [nsv_get apm_library_mtime "packages/$package_key/$file"]
+ } {
return "needs_reload"
}
}
@@ -696,9 +698,10 @@
# !( 1 ^ 0 ) = Nope
# !( 1 ^ 1 ) = Yep
#
- if {!($test_queries_p ^ $is_test_file_p) &&
- $file_type eq "query_file" &&
- ($file_db_type eq "" || $file_db_type eq [db_type])} {
+ if {!($test_queries_p ^ $is_test_file_p)
+ && $file_type eq "query_file"
+ && ($file_db_type eq "" || $file_db_type eq [db_type])
+ } {
db_qd_load_query_file $file
}
}
@@ -770,9 +773,10 @@
set path "[acs_root_dir]/$file"
ns_log Debug "APM: File being watched: $path"
- if { [file exists $path] && \
- (![nsv_exists apm_library_mtime $file] || \
- [file mtime $path] != [nsv_get apm_library_mtime $file]) } {
+ if { [file exists $path]
+ && (![nsv_exists apm_library_mtime $file] ||
+ [file mtime $path] ne [nsv_get apm_library_mtime $file])
+ } {
lappend files_to_reload $file
}
}
@@ -1591,7 +1595,7 @@
@author Peter Marklund
} {
- return [expr [lsearch -exact [apm_supported_callback_types] $type] >= 0]
+ return [expr {$type in [apm_supported_callback_types]}]
}
ad_proc -public apm_callback_format_args {
@@ -1994,7 +1998,10 @@
# ignore drop and upgrade scripts
set pg_files {}
foreach file $filelist {
- if { [string match {*/postgresql/*} $file] && ![string match *-drop.sql $file] && ![string match {*/upgrade/*} $file] } {
+ if { [string match {*/postgresql/*} $file]
+ && ![string match *-drop.sql $file]
+ && ![string match {*/upgrade/*} $file]
+ } {
lappend pg_files $file
}
}
@@ -2004,7 +2011,10 @@
# ignore drop and upgrade scripts
set ora_files {}
foreach file $filelist {
- if { [string match {*/oracle/*} $file] && ![string match *-drop.sql $file] && ![string match {*/upgrade/*} $file] } {
+ if { [string match {*/oracle/*} $file]
+ && ![string match *-drop.sql $file]
+ && ![string match {*/upgrade/*} $file]
+ } {
lappend ora_files $file
}
}
Index: openacs-4/packages/acs-tcl/tcl/application-data-link-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/application-data-link-procs.tcl,v
diff -u -N -r1.12.4.1 -r1.12.4.2
--- openacs-4/packages/acs-tcl/tcl/application-data-link-procs.tcl 2 Oct 2013 07:44:14 -0000 1.12.4.1
+++ openacs-4/packages/acs-tcl/tcl/application-data-link-procs.tcl 2 Oct 2013 22:55:55 -0000 1.12.4.2
@@ -327,23 +327,34 @@
@author Dave Bauer (dave@solutiongrove.com)
@creation-date 2006-08-31
} {
- set old_links [application_data_link::get_links_from -object_id $object_id -relation_tag $relation_tag]
+ set old_links [application_data_link::get_links_from \
+ -object_id $object_id \
+ -relation_tag $relation_tag]
+
if {![llength $link_object_ids]} {
set link_object_ids [application_data_link::scan_for_links -text $text]
}
set delete_ids [list]
foreach old_link $old_links {
- if {[lsearch $link_object_ids $old_link] < 0} {
+ if {$old_link ni $link_object_ids} {
lappend delete_ids $old_link
}
}
- application_data_link::delete_from_list -object_id $object_id -link_object_id_list $delete_ids -relation_tag $relation_tag
+ application_data_link::delete_from_list \
+ -object_id $object_id \
+ -link_object_id_list $delete_ids \
+ -relation_tag $relation_tag
+
foreach new_link $link_object_ids {
if {![application_data_link::link_exists \
-from_object_id $object_id \
-to_object_id $new_link \
- -relation_tag $relation_tag]} {
- application_data_link::new_from -object_id $object_id -to_object_id $new_link -relation_tag $relation_tag
+ -relation_tag $relation_tag]
+ } {
+ application_data_link::new_from \
+ -object_id $object_id \
+ -to_object_id $new_link \
+ -relation_tag $relation_tag
}
}
}
Index: openacs-4/packages/acs-tcl/tcl/defs-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/defs-procs.tcl,v
diff -u -N -r1.62.2.5 -r1.62.2.6
--- openacs-4/packages/acs-tcl/tcl/defs-procs.tcl 28 Sep 2013 15:38:30 -0000 1.62.2.5
+++ openacs-4/packages/acs-tcl/tcl/defs-procs.tcl 2 Oct 2013 22:55:55 -0000 1.62.2.6
@@ -404,19 +404,21 @@
@param title Title to be used for the error (will be shown to user)
@param explanation Explanation for the exception.
} {
- set error_template [parameter::get_from_package_key -package_key "acs-tcl" -parameter "ReturnError" -default "/packages/acs-tcl/lib/ad-return-error"]
+ set error_template [parameter::get_from_package_key \
+ -package_key "acs-tcl" \
+ -parameter "ReturnError" \
+ -default "/packages/acs-tcl/lib/ad-return-error"]
set page [ad_parse_template -params [list [list title $title] [list explanation $explanation]] $error_template]
if {$status > 399
&& [string match {*; MSIE *} [ns_set iget [ad_conn headers] User-Agent]]
&& [string length $page] < 512 } {
- append page [string repeat " " [expr 513 - [string length $page]]]
+ append page [string repeat " " [expr {513 - [string length $page]}]]
}
ns_return $status text/html $page
# raise abortion flag, e.g., for templating
- global request_aborted
- set request_aborted [list $status $title]
+ set ::request_aborted [list $status $title]
}
Index: openacs-4/packages/acs-tcl/tcl/exception-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/exception-procs.tcl,v
diff -u -N -r1.3.10.1 -r1.3.10.2
--- openacs-4/packages/acs-tcl/tcl/exception-procs.tcl 29 Sep 2013 19:23:18 -0000 1.3.10.1
+++ openacs-4/packages/acs-tcl/tcl/exception-procs.tcl 2 Oct 2013 22:55:55 -0000 1.3.10.2
@@ -29,12 +29,13 @@
@see with_finally
@see with_catch
} {
- global errorInfo errorCode
if {[set errno [catch {uplevel $code} result]]} {
- if {$errno == 1 && [string equal [lindex $errorCode 0] "AD"] && \
- [string equal [lindex $errorCode 1] "EXCEPTION"]} {
- set exception [lindex $errorCode 2]
+ if {$errno == 1
+ && [lindex $::errorCode 0] eq "AD"
+ && [lindex $::errorCode 1] eq "EXCEPTION"
+ } {
+ set exception [lindex $::errorCode 2]
set matched 0
for {set i 0} {$i < [llength $args]} {incr i 3} {
@@ -51,6 +52,6 @@
}
}
- return -code $errno -errorcode $errorCode -errorinfo $errorInfo $result
+ return -code $errno -errorcode $::errorCode -errorinfo $::errorInfo $result
}
}
Index: openacs-4/packages/acs-tcl/tcl/form-processing-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/form-processing-procs.tcl,v
diff -u -N -r1.63.6.4 -r1.63.6.5
--- openacs-4/packages/acs-tcl/tcl/form-processing-procs.tcl 30 Sep 2013 11:22:01 -0000 1.63.6.4
+++ openacs-4/packages/acs-tcl/tcl/form-processing-procs.tcl 2 Oct 2013 22:55:55 -0000 1.63.6.5
@@ -558,8 +558,9 @@
foreach valid_arg $valid_args {
if { [info exists $valid_arg] } {
- if { [info exists af_parts(${form_name}__$valid_arg)] &&
- [lsearch { form name validate export } $valid_arg] == -1 } {
+ if { [info exists af_parts(${form_name}__$valid_arg)]
+ && [lsearch { form name validate export } $valid_arg] == -1
+ } {
return -code error "Form \"$form_name\" already has a \"$valid_arg\" section"
}
@@ -1016,8 +1017,9 @@
foreach element_name $properties(element_names) {
if { [info exists values($element_name)] } {
- if { [info exists af_flag_list(${form_name}__$element_name)] && \
- [lsearch $af_flag_list(${form_name}__$element_name) multiple] >= 0 } {
+ if { [info exists af_flag_list(${form_name}__$element_name)]
+ && [lsearch $af_flag_list(${form_name}__$element_name) multiple] >= 0
+ } {
template::element set_values $form_name $element_name $values($element_name)
} else {
template::element set_value $form_name $element_name $values($element_name)
@@ -1034,8 +1036,9 @@
# in a reasonable way.
foreach element_name $properties(element_names) {
- if { [info exists af_flag_list(${form_name}__$element_name)] && \
- [lsearch $af_flag_list(${form_name}__$element_name) multiple] >= 0 } {
+ if { [info exists af_flag_list(${form_name}__$element_name)]
+ && [lsearch $af_flag_list(${form_name}__$element_name) multiple] >= 0
+ } {
set values [uplevel #$level [list template::element get_values $form_name $element_name]]
uplevel #$level [list set $element_name $values]
} else {
@@ -1065,8 +1068,9 @@
foreach validate_element $af_validate_elements($form_name) {
foreach {element_name validate_expr error_message} $validate_element {
- if { ![template::element error_p $form_name $element_name] && \
- ![uplevel #$level [list expr $validate_expr]] } {
+ if { ![template::element error_p $form_name $element_name]
+ && ![uplevel #$level [list expr $validate_expr]]
+ } {
template::element set_error $form_name $element_name [uplevel [list subst $error_message]]
}
}
Index: openacs-4/packages/acs-tcl/tcl/request-processor-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/request-processor-procs.tcl,v
diff -u -N -r1.113.2.10 -r1.113.2.11
--- openacs-4/packages/acs-tcl/tcl/request-processor-procs.tcl 30 Sep 2013 09:39:08 -0000 1.113.2.10
+++ openacs-4/packages/acs-tcl/tcl/request-processor-procs.tcl 2 Oct 2013 22:55:56 -0000 1.113.2.11
@@ -224,7 +224,7 @@
return
}
- if { [lsearch -exact { GET POST HEAD } $method] == -1 } {
+ if {$method ni { GET POST HEAD }} {
error "Method passed to ad_register_proc must be one of GET, POST, or HEAD"
}
@@ -259,25 +259,27 @@
}
}
- global errorCode
if { $errno } {
- # Uh-oh - an error occurred.
- global errorInfo
- ds_add rp [list filter [list $why [ns_conn method] [ns_conn url] $proc $arg] $startclicks [clock clicks -milliseconds] "error" $errorInfo]
- # make sure you report catching the error!
- rp_debug "error in filter $proc for [ns_conn method] [ns_conn url]?[ns_conn query] errno is $errno message is $errorInfo"
- rp_report_error
- set result "filter_return"
- } elseif {$result ne "filter_ok" && $result ne "filter_break" && \
- [string compare $result "filter_return"] } {
+ # Uh-oh - an error occurred.
+ ds_add rp [list filter [list $why [ns_conn method] [ns_conn url] $proc $arg] \
+ $startclicks [clock clicks -milliseconds] "error" $::errorInfo]
+ # make sure you report catching the error!
+ rp_debug "error in filter $proc for [ns_conn method] [ns_conn url]?[ns_conn query] errno is $errno message is $::errorInfo"
+ rp_report_error
+ set result "filter_return"
+
+ } elseif {$result ne "filter_ok" && $result ne "filter_break" && $result ne "filter_return" } {
+
set error_msg "error in filter $proc for [ns_conn method] [ns_conn url]?[ns_conn query]. Filter returned invalid result \"$result\""
- ds_add rp [list filter [list $why [ns_conn method] [ns_conn url] $proc $arg] $startclicks [clock clicks -milliseconds] "error" $error_msg]
+ ds_add rp [list filter [list $why [ns_conn method] [ns_conn url] $proc $arg] \
+ $startclicks [clock clicks -milliseconds] "error" $error_msg]
# report the bad filter_return message
rp_debug -debug t -ns_log_level error $error_msg
rp_report_error -message $error_msg
set result "filter_return"
} else {
- ds_add rp [list filter [list $why [ns_conn method] [ns_conn url] $proc $arg] $startclicks [clock clicks -milliseconds] $result]
+ ds_add rp [list filter [list $why [ns_conn method] [ns_conn url] $proc $arg] \
+ $startclicks [clock clicks -milliseconds] $result]
}
rp_debug -debug $debug_p "Done invoking $why filter $proc (returning $result)"
@@ -385,7 +387,7 @@
return
}
- if { [lsearch -exact { GET POST HEAD } $method] == -1 } {
+ if {$method ni { GET POST HEAD }} {
error "Method passed to ad_register_filter must be one of GET, POST, or HEAD"
}
@@ -572,7 +574,7 @@
# 4. set urlv and urlc for consistency
set urlv [lrange [split $root /] 1 end]
- ad_conn -set urlc [expr [ad_conn urlc]+[llength $urlv]]
+ ad_conn -set urlc [expr {[ad_conn urlc] + [llength $urlv]}]
ad_conn -set urlv [concat $urlv [ad_conn urlv]]
}
# -------------------------------------------------------------------------
@@ -592,15 +594,17 @@
ns_log Debug "user agent is $user_agent"
if {[string match "*YahooSeeker*" $user_agent]
- || [string match ".*Yahoo! Slurp.*" $user_agent]} {
+ || [string match ".*Yahoo! Slurp.*" $user_agent]
+ } {
ns_log Notice "nasty spider $user_agent"
ns_returnredirect "http://www.yahoo.com"
return "filter_return"
}
## BLOCK NASTY YAHOO FINISH
if { $root eq ""
- && [parameter::get -package_id [ad_acs_kernel_id] -parameter ForceHostP -default 0] } {
+ && [parameter::get -package_id [ad_acs_kernel_id] -parameter ForceHostP -default 0]
+ } {
set host_header [ns_set iget [ns_conn headers] "Host"]
regexp {^([^:]*)} $host_header "" host_no_port
regexp {^https?://([^:]+)} [ns_conn location] "" desired_host_no_port
@@ -777,8 +781,9 @@
set error_message $message
- if {[parameter::get -package_id [ad_acs_kernel_id] -parameter RestrictErrorsToAdminsP -default 0] && \
- ![permission::permission_p -object_id [ad_conn package_id] -privilege admin] } {
+ if {[parameter::get -package_id [ad_acs_kernel_id] -parameter RestrictErrorsToAdminsP -default 0]
+ && ![permission::permission_p -object_id [ad_conn package_id] -privilege admin]
+ } {
set message {}
set params [lreplace $params 0 0 [list stacktrace $message]]
}
@@ -1465,13 +1470,14 @@
# don't touch anything.
set modify_p 1
- if { [ns_set ifind $headers "cache-control"] > -1 ||
- [ns_set ifind $headers "expires"] > -1 } {
+ if { [ns_set ifind $headers "cache-control"] > -1
+ || [ns_set ifind $headers "expires"] > -1 } {
set modify_p 0
} else {
for { set i 0 } { $i < [ns_set size $headers] } { incr i } {
- if { [string tolower [ns_set key $headers $i]] eq "pragma" &&
- [string tolower [ns_set value $headers $i]] eq "no-cache" } {
+ if { [string tolower [ns_set key $headers $i]] eq "pragma"
+ && [string tolower [ns_set value $headers $i]] eq "no-cache"
+ } {
set modify_p 0
break
}
Index: openacs-4/packages/acs-tcl/tcl/server-cluster-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/server-cluster-procs.tcl,v
diff -u -N -r1.8 -r1.8.8.1
--- openacs-4/packages/acs-tcl/tcl/server-cluster-procs.tcl 13 Feb 2009 20:28:08 -0000 1.8
+++ openacs-4/packages/acs-tcl/tcl/server-cluster-procs.tcl 2 Oct 2013 22:55:56 -0000 1.8.8.1
@@ -100,9 +100,11 @@
set canonical_port 80
set canonical_ip $canonical_server
}
-
- if { [ns_config ns/server/[ns_info server]/module/nssock Address] == $canonical_ip && \
- [ns_config ns/server/[ns_info server]/module/nssock Port 80] == $canonical_port } {
+
+ set driver_section [ns_driversection -driver nssock]
+ if { [ns_config $driver_section Address] == $canonical_ip
+ && [ns_config $driver_section Port 80] == $canonical_port
+ } {
return 1
}
Index: openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl,v
diff -u -N -r1.90.2.2 -r1.90.2.3
--- openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl 29 Sep 2013 14:55:33 -0000 1.90.2.2
+++ openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl 2 Oct 2013 22:55:56 -0000 1.90.2.3
@@ -799,7 +799,7 @@
if { $include_self_p && $package_key ne ""} {
array set node_array [site_node::get -url $url]
- if { [lsearch -exact $package_key $node_array(package_key)] != -1 } {
+ if {$node_array(package_key) in $package_key} {
return $node_array($element)
}
}
@@ -1015,7 +1015,7 @@
# Try the URL as is.
if {[catch {nsv_get site_nodes $url} result] == 0} {
array set node $result
- if { [lsearch -exact $package_keys $node(package_key)] != -1 } {
+ if {$node(package_key) in $package_keys} {
return $node(package_id)
}
}
@@ -1025,7 +1025,7 @@
append url "/"
if {[catch {nsv_get site_nodes $url} result] == 0} {
array set node $result
- if { [lsearch -exact $package_keys $node(package_key)] != -1 } {
+ if {$node(package_key) in $package_keys} {
return $node(package_id)
}
}
Index: openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl,v
diff -u -N -r1.30.2.6 -r1.30.2.7
--- openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl 29 Sep 2013 20:24:03 -0000 1.30.2.6
+++ openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl 2 Oct 2013 22:55:56 -0000 1.30.2.7
@@ -892,7 +892,9 @@
}
}
- if { [info exists apc_internal_filter($formal_name:multiple)] && $actual_value eq "" } {
+ if { [info exists apc_internal_filter($formal_name:multiple)]
+ && $actual_value eq ""
+ } {
# LARS:
# If you lappend an emptry_string, it'll actually add the empty string to the list as an element
# which is not what we want
@@ -977,7 +979,11 @@
upvar 1 $formal_name var
if { [info exists apc_internal_filter($formal_name:cached)] } {
- if { ![ad_page_contract_get_validation_passed_p $formal_name] && ![info exists apc_internal_filter($formal_name:notnull)] && (![info exists apc_default_value($formal_name)] || $apc_default_value($formal_name) eq "") } {
+ if { ![ad_page_contract_get_validation_passed_p $formal_name]
+ && ![info exists apc_internal_filter($formal_name:notnull)]
+ && (![info exists apc_default_value($formal_name)]
+ || $apc_default_value($formal_name) eq "")
+ } {
if { [info exists apc_internal_filter($formal_name:array)] } {
# This is an array variable, so we need to loop through each name.* variable for this package we have ...
set array_list ""
@@ -1003,15 +1009,17 @@
if { [info exists apc_internal_filter($formal_name:verify)] } {
if { ![info exists apc_internal_filter($formal_name:array)] } {
# This is not an array, verify the variable
- if { ![info exists apc_signatures($formal_name)] || \
- ![ad_verify_signature $var $apc_signatures($formal_name)] } {
+ if { ![info exists apc_signatures($formal_name)]
+ || ![ad_verify_signature $var $apc_signatures($formal_name)]
+ } {
ad_complain -key $formal_name:verify "[_ acs-tcl.lt_The_signature_for_the]"
continue
}
} else {
# This is an array: verify the [array get] form of the array
- if { ![info exists apc_signatures($formal_name)] || \
- ![ad_verify_signature [lsort [array get var]] $apc_signatures($formal_name)] } {
+ if { ![info exists apc_signatures($formal_name)]
+ || ![ad_verify_signature [lsort [array get var]] $apc_signatures($formal_name)]
+ } {
ad_complain -key $formal_name:verify "[_ acs-tcl.lt_The_signature_for_the]"
continue
}
@@ -1095,8 +1103,9 @@
set validation_ok_p [ad_page_contract_eval uplevel 1 $code]
set ad_page_contract_errorkeys [lrange $ad_page_contract_errorkeys 1 end]
- if { $validation_ok_p eq "" || \
- ($validation_ok_p ne "1" && $validation_ok_p ne "0" )} {
+ if { $validation_ok_p eq ""
+ || ($validation_ok_p ne "1" && $validation_ok_p ne "0" )
+ } {
set validation_ok_p [expr {[ad_complaints_count] == $no_complaints_before}]
}
@@ -1135,7 +1144,10 @@
}
# Set the __submit_button_variable. This is used in double click protection.
- if {[info exists __submit_button_name] && $__submit_button_name ne "" && [info exists __submit_button_value]} {
+ if {[info exists __submit_button_name]
+ && $__submit_button_name ne ""
+ && [info exists __submit_button_value]
+ } {
uplevel 1 [list set $__submit_button_name $__submit_button_value]
}
@@ -1657,18 +1669,18 @@
}
if {
- "" eq $date(month) \
- || "" eq $date(day) \
- || "" eq $date(year) \
- || $date(month) < 1 || $date(month) > 12 \
- || $date(day) < 1 || $date(day) > 31 \
- || $date(year) < 1 \
- || ($date(month) == 2 && $date(day) > 29) \
- || (($date(year) % 4) != 0 && $date(month) == 2 && $date(day) > 28) \
- || ($date(month) == 4 && $date(day) > 30) \
- || ($date(month) == 6 && $date(day) > 30) \
- || ($date(month) == 9 && $date(day) > 30) \
- || ($date(month) == 11 && $date(day) > 30)
+ "" eq $date(month)
+ || "" eq $date(day)
+ || "" eq $date(year)
+ || $date(month) < 1 || $date(month) > 12
+ || $date(day) < 1 || $date(day) > 31
+ || $date(year) < 1
+ || ($date(month) == 2 && $date(day) > 29)
+ || (($date(year) % 4) != 0 && $date(month) == 2 && $date(day) > 28)
+ || ($date(month) == 4 && $date(day) > 30)
+ || ($date(month) == 6 && $date(day) > 30)
+ || ($date(month) == 9 && $date(day) > 30)
+ || ($date(month) == 11 && $date(day) > 30)
} {
ad_complain "[_ acs-tcl.lt_Invalid_date_datemont]"
return 0
@@ -1709,13 +1721,13 @@
}
if {
- "" eq $time(hours) \
- || "" eq $time(minutes) \
- || "" eq $time(seconds) \
- || (![string equal -nocase "pm" $time(ampm)] && ![string equal -nocase "am" $time(ampm)])
- || $time(hours) < 1 || $time(hours) > 12 \
- || $time(minutes) < 0 || $time(minutes) > 59 \
- || $time(seconds) < 0 || $time(seconds) > 59
+ "" eq $time(hours)
+ || "" eq $time(minutes)
+ || "" eq $time(seconds)
+ || (![string equal -nocase "pm" $time(ampm)] && ![string equal -nocase "am" $time(ampm)])
+ || $time(hours) < 1 || $time(hours) > 12
+ || $time(minutes) < 0 || $time(minutes) > 59
+ || $time(seconds) < 0 || $time(seconds) > 59
} {
ad_complain "[_ acs-tcl.lt_Invalid_time_timetime_1]"
return 0
Index: openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl,v
diff -u -N -r1.65.6.7 -r1.65.6.8
--- openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 29 Sep 2013 20:24:03 -0000 1.65.6.7
+++ openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 2 Oct 2013 22:55:56 -0000 1.65.6.8
@@ -783,13 +783,15 @@
set attr_name [lindex $attribute 0]
set attr_value [lindex $attribute 1]
- if { ![info exists allowed_attribute($attr_name)] && ![info exists allowed_attribute(*)] } {
+ if { ![info exists allowed_attribute($attr_name)]
+ && ![info exists allowed_attribute(*)] } {
return "The attribute '$attr_name' is not allowed for $tagname tags"
}
if { [string tolower $attr_name] ne "style" } {
if { [regexp {^\s*([^\s:]+):\/\/} $attr_value match protocol] } {
- if { ![info exists allowed_protocol([string tolower $protocol])] && ![info exists allowed_protocol(*)] } {
+ if { ![info exists allowed_protocol([string tolower $protocol])]
+ && ![info exists allowed_protocol(*)] } {
return "Your URLs can only use these protocols: [join $allowed_protocols_list ", "].
You have a '$protocol' protocol in there."
}
@@ -856,11 +858,12 @@
# - alpha or
# - a slash, and then alpha
# Otherwise, it's probably just a lone < character
- if { $i >= $length - 1 || \
- (![string is alpha [string index $html $i+1]] && \
- [string index $html $i+1] ne "!" && \
- ("/" ne [string index $html $i+1] || \
- ![string is alpha [string index $html $i+2]])) } {
+ if { $i >= $length - 1 ||
+ (![string is alpha [string index $html $i+1]]
+ && [string index $html $i+1] ne "!"
+ && ("/" ne [string index $html $i+1] ||
+ ![string is alpha [string index $html $i+2]]))
+ } {
# Output the < and continue with next character
ad_html_to_text_put_text output "<"
set last_tag_end [incr i]
Index: openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl,v
diff -u -N -r1.133.2.23 -r1.133.2.24
--- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 29 Sep 2013 20:24:03 -0000 1.133.2.23
+++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 2 Oct 2013 22:55:56 -0000 1.133.2.24
@@ -1221,8 +1221,8 @@
set varname [ns_set key $the_form $i]
set varvalue [ns_set value $the_form $i]
if {
- $vars_to_passthrough eq "" ||
- ($varname in $vars_to_passthrough)
+ $vars_to_passthrough eq ""
+ || ($varname in $vars_to_passthrough)
} {
lappend params "[ns_urlencode $varname]=[ns_urlencode $varvalue]"
}
@@ -1943,8 +1943,9 @@
set headers [ns_conn outputheaders]
set nr_headers [ns_set size $headers]
for { set i 0 } { $i < $nr_headers } { incr i } {
- if { [string tolower [ns_set key $headers $i]] eq "set-cookie" && \
- [regexp "^$name=(\[^;\]*)" [ns_set value $headers $i] match value] } {
+ if { [string tolower [ns_set key $headers $i]] eq "set-cookie"
+ && [regexp "^$name=(\[^;\]*)" [ns_set value $headers $i] match value]
+ } {
return $value
}
}
@@ -2016,8 +2017,9 @@
if { $replace } {
# Try to find an already-set cookie named $name.
for { set i 0 } { $i < [ns_set size $headers] } { incr i } {
- if { [string tolower [ns_set key $headers $i]] eq "set-cookie" &&
- [string match "$name=*" [ns_set value $headers $i]] } {
+ if { [string tolower [ns_set key $headers $i]] eq "set-cookie"
+ && [string match "$name=*" [ns_set value $headers $i]]
+ } {
ns_set delete $headers $i
}
}
@@ -2503,7 +2505,7 @@
# suppress the configured http port when server is behind a proxy, to keep connection behind proxy
set suppress_port [parameter::get -package_id [apm_package_id_from_key acs-tcl] -parameter SuppressHttpPort -default 0]
- if { $suppress_port && [string equal $port [ns_config -int "ns/server/[ns_info server]/module/nssock" Port]] } {
+ if { $suppress_port && $port eq [ns_config -int "ns/server/[ns_info server]/module/nssock" Port] } {
ns_log Debug "util_current_location: suppressing http port $Host_port"
set Host_port ""
set port ""
@@ -3878,8 +3880,8 @@
# characters in length.
#
if {
- [regexp -nocase {[^a-z_]or[^a-z0-9_]} $value] ||
- [regexp -nocase {union([^a-z0-9_].*all)?[^a-z0-9_].*select} $value]
+ [regexp -nocase {[^a-z_]or[^a-z0-9_]} $value]
+ || [regexp -nocase {union([^a-z0-9_].*all)?[^a-z0-9_].*select} $value]
} {
# Looks like the user has added "union [all] select" to
# the variable, # or is trying to modify the WHERE clause
@@ -3919,12 +3921,12 @@
}
if {
- $parse_result_integer == 0 ||
- $parse_result_integer == -904 ||
- $parse_result_integer == -1789 ||
- $parse_result_string == 0 ||
- $parse_result_string == -904 ||
- $parse_result_string == -1789
+ $parse_result_integer == 0
+ || $parse_result_integer == -904
+ || $parse_result_integer == -1789
+ || $parse_result_string == 0
+ || $parse_result_string == -904
+ || $parse_result_string == -1789
} {
# Code -904 means "invalid column", -1789 means
# "incorrect number of result columns". We treat this
Index: openacs-4/packages/acs-tcl/tcl/widgets-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/widgets-procs.tcl,v
diff -u -N -r1.17.2.3 -r1.17.2.4
--- openacs-4/packages/acs-tcl/tcl/widgets-procs.tcl 24 Sep 2013 19:39:53 -0000 1.17.2.3
+++ openacs-4/packages/acs-tcl/tcl/widgets-procs.tcl 2 Oct 2013 22:55:57 -0000 1.17.2.4
@@ -213,7 +213,8 @@
set item [lindex $opt 1]
set value [lindex $opt 0]
if { (!$multiple && $value eq $default )
- || ($multiple && [lsearch -exact $default $value] > -1)} {
+ || ($multiple && $value in $default)
+ } {
append retval "\n"
} else {
append retval "\n"
@@ -234,7 +235,8 @@
set item [ns_set value $selection 0]
set value [ns_set value $selection 1]
if { (!$multiple && $value eq $default )
- || ($multiple && [lsearch -exact $default $value] > -1)} {
+ || ($multiple && $value in $default)
+ } {
append retval "\n"
} else {
append retval "\n"
Index: openacs-4/packages/acs-tcl/tcl/xml-0-sgml-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/xml-0-sgml-procs.tcl,v
diff -u -N -r1.3.10.3 -r1.3.10.4
--- openacs-4/packages/acs-tcl/tcl/xml-0-sgml-procs.tcl 29 Sep 2013 19:28:13 -0000 1.3.10.3
+++ openacs-4/packages/acs-tcl/tcl/xml-0-sgml-procs.tcl 2 Oct 2013 22:55:57 -0000 1.3.10.4
@@ -541,8 +541,9 @@
regsub -all &xml:intdtd\; $text \[$options(-internaldtd)\] text
# Look for entity references
- if {([array size entities] || [string length $options(-entityreferencecommand)]) && \
- [regexp {&[^;]+;} $text]} {
+ if {([array size entities] || [string length $options(-entityreferencecommand)])
+ && [regexp {&[^;]+;} $text]
+ } {
# protect Tcl specials
regsub -all {([][$\\])} $text {\\\1} text
Index: openacs-4/packages/acs-tcl/tcl/xml-1-dom-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/xml-1-dom-procs.tcl,v
diff -u -N -r1.3.10.2 -r1.3.10.3
--- openacs-4/packages/acs-tcl/tcl/xml-1-dom-procs.tcl 29 Sep 2013 11:50:55 -0000 1.3.10.2
+++ openacs-4/packages/acs-tcl/tcl/xml-1-dom-procs.tcl 2 Oct 2013 22:55:57 -0000 1.3.10.3
@@ -562,8 +562,9 @@
if {$parent(node:nodeType) eq "documentFragment" } {
if {$parent(id) == $parent(documentFragment:masterDoc)} {
- if {[info exists parent(document:documentElement)] && \
- [string length $parent(document:documentElement)]} {
+ if {[info exists parent(document:documentElement)]
+ && [string length $parent(document:documentElement)]
+ } {
unset docArray($id)
return -code error "document element already exists"
} else {
@@ -1308,8 +1309,9 @@
foreach child [set $node(node:childNodes)] {
catch {unset childNode}
array set childNode [set $child]
- if {$childNode(node:nodeType) eq "element" && \
- [GetField childNode(node:nodeName)] eq $name } {
+ if {$childNode(node:nodeType) eq "element"
+ && [GetField childNode(node:nodeName)] eq $name
+ } {
lappend result $child
}
}
Index: openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl,v
diff -u -N -r1.40.6.2 -r1.40.6.3
--- openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl 29 Sep 2013 14:55:33 -0000 1.40.6.2
+++ openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl 2 Oct 2013 22:55:57 -0000 1.40.6.3
@@ -101,7 +101,7 @@
array set parsed_callback_array $spec_array(callbacks)
aa_true "Only one permissible callback should be returned, got array [array get parsed_callback_array]" \
- [expr [llength [array names parsed_callback_array]] == 1]
+ [expr {[llength [array names parsed_callback_array]] == 1}]
aa_equals "Checking name of callback of allowed type $allowed_type" \
$parsed_callback_array($allowed_type) $callback_array($allowed_type)
@@ -289,7 +289,7 @@
# nonexistent package_type
aa_true "No nodes with package type 'foo'" \
- [expr [llength [site_node::get_children -all -element node_id -node_id $node_id -package_type "foo"]] == 0]
+ [expr {[llength [site_node::get_children -all -element node_id -node_id $node_id -package_type "foo"]] == 0}]
}
Index: openacs-4/packages/acs-tcl/tcl/test/ad-proc-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/ad-proc-test-procs.tcl,v
diff -u -N -r1.9.2.1 -r1.9.2.2
--- openacs-4/packages/acs-tcl/tcl/test/ad-proc-test-procs.tcl 30 Sep 2013 12:00:56 -0000 1.9.2.1
+++ openacs-4/packages/acs-tcl/tcl/test/ad-proc-test-procs.tcl 2 Oct 2013 22:55:58 -0000 1.9.2.2
@@ -25,16 +25,12 @@
ad_proc -callback a_callback { -arg1 arg2 } { this is a test callback } -
set callback_procs [info commands ::callback::a_callback::*]
aa_true "creation of a valid callback contract with '-' body" \
- [expr {[lsearch -exact \
- $callback_procs \
- ::callback::a_callback::contract] >= 0}]
+ [expr {"::callback::a_callback::contract" in $callback_procs}]
ad_proc -callback a_callback_2 { arg1 arg2 } { this is a test callback } {}
set callback_procs [info commands ::callback::a_callback_2::*]
aa_true "creation of a valid callback contract with no body" \
- [expr {[lsearch -exact \
- $callback_procs \
- ::callback::a_callback_2::contract] >= 0}]
+ [expr {"::callback::a_callback_2::contract" in $callback_procs}]
aa_true "throw error for missing -callback on implementation definition" \
[catch {
@@ -52,9 +48,7 @@
}
set impl_procs [info commands ::callback::a_callback::impl::*]
aa_true "creation of a valid callback implementation" \
- [expr {[lsearch -exact \
- $impl_procs \
- ::callback::a_callback::impl::an_impl] >= 0}]
+ [expr {"::callback::a_callback::impl::an_impl" in $impl_procs}]
}
ad_proc -callback a_callback {
Index: openacs-4/packages/acs-tcl/tcl/test/application-data-link-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/application-data-link-procs.tcl,v
diff -u -N -r1.4 -r1.4.6.1
--- openacs-4/packages/acs-tcl/tcl/test/application-data-link-procs.tcl 4 Jan 2010 19:54:37 -0000 1.4
+++ openacs-4/packages/acs-tcl/tcl/test/application-data-link-procs.tcl 2 Oct 2013 22:55:58 -0000 1.4.6.1
@@ -218,20 +218,23 @@
application_data_link::new -this_object_id $o(3) -target_object_id $o(4) -relation_tag tag2
application_data_link::new -this_object_id $o(3) -target_object_id $o(5) -relation_tag tag2
- aa_true "Verify link for tag1" [expr [llength [application_data_link::get_linked -from_object_id $o(0) \
- -to_object_type [acs_object_type $o(0)] -relation_tag tag1]] == 2]
+ aa_true "Verify link for tag1" \
+ [expr {[llength [application_data_link::get_linked -from_object_id $o(0) \
+ -to_object_type [acs_object_type $o(0)] -relation_tag tag1]] == 2}]
- aa_true "Verify link for tag2" [expr [llength [application_data_link::get_linked -from_object_id $o(3) \
- -to_object_type [acs_object_type $o(3)] -relation_tag tag2]] == 3]
+ aa_true "Verify link for tag2" \
+ [expr {[llength [application_data_link::get_linked -from_object_id $o(3) \
+ -to_object_type [acs_object_type $o(3)] -relation_tag tag2]] == 3}]
- aa_true "Verify content link" [expr [llength [application_data_link::get_linked_content -from_object_id $o(0) \
- -to_content_type content_revision -relation_tag tag1]] == 2]
+ aa_true "Verify content link" \
+ [expr {[llength [application_data_link::get_linked_content -from_object_id $o(0) \
+ -to_content_type content_revision -relation_tag tag1]] == 2}]
aa_true "Verify links to one object with multiple link tags" \
- [expr [llength [application_data_link::get -object_id $o(0) -relation_tag tag1]] == 2]
+ [expr {[llength [application_data_link::get -object_id $o(0) -relation_tag tag1]] == 2}]
aa_true "Verify links to one object with multiple link tags" \
- [expr [llength [application_data_link::get -object_id $o(0) -relation_tag tag2]] == 1]
+ [expr {[llength [application_data_link::get -object_id $o(0) -relation_tag tag2]] == 1}]
}
}
\ No newline at end of file
Index: openacs-4/packages/acs-tcl/tcl/test/whos-online-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/whos-online-procs.tcl,v
diff -u -N -r1.5 -r1.5.8.1
--- openacs-4/packages/acs-tcl/tcl/test/whos-online-procs.tcl 10 Feb 2009 20:42:43 -0000 1.5
+++ openacs-4/packages/acs-tcl/tcl/test/whos-online-procs.tcl 2 Oct 2013 22:55:58 -0000 1.5.8.1
@@ -49,8 +49,8 @@
#Test all-invisible_user_ids
#---------------------------------------------------------------------------------------------------
- aa_true "User $user_info(email) with user_id=$user_id is in the invisible list"\
- [expr [lsearch [whos_online::all_invisible_user_ids] $user_id] >= 0]
+ aa_true "User $user_info(email) with user_id=$user_id is in the invisible list" \
+ [expr {$user_id in [whos_online::all_invisible_user_ids]}]
#---------------------------------------------------------------------------------------------------
#Test unset_invisible
@@ -67,8 +67,8 @@
#Test user_ids
#---------------------------------------------------------------------------------------------------
- aa_true "User $user_info(email) with user_id=$user_id is in the visible list"\
- [expr [lsearch [whos_online::user_ids] $user_id] >= 0]
+ aa_true "User $user_info(email) with user_id=$user_id is in the visible list" \
+ [expr {$user_id in [whos_online::user_ids]}]
twt::user::logout
twt::user::delete -user_id $user_id