Index: openacs-4/bin/create-tablespace.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/bin/create-tablespace.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/bin/create-tablespace.tcl 13 Mar 2003 06:09:04 -0000 1.1
+++ openacs-4/bin/create-tablespace.tcl 10 Jan 2007 21:21:58 -0000 1.2
@@ -50,7 +50,7 @@
} else {
# oracle_data_path specified. make sure it has a trailing slash.
set oracle_data_path [lindex $argv 2]
- if { [string index $oracle_data_path end] != "/" } {
+ if { [string index $oracle_data_path end] ne "/" } {
set oracle_data_path "${oracle_data_path}/"
}
}
Index: openacs-4/etc/config.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/config.tcl,v
diff -u -r1.40 -r1.41
--- openacs-4/etc/config.tcl 30 Oct 2006 12:16:16 -0000 1.40
+++ openacs-4/etc/config.tcl 10 Jan 2007 21:21:58 -0000 1.41
@@ -36,7 +36,7 @@
set db_name $server
-if { $database == "oracle" } {
+if { $database eq "oracle" } {
set db_password "mysitepassword"
} else {
set db_host localhost
@@ -101,7 +101,7 @@
ns_section ns/threads
ns_param mutexmeter true ;# measure lock contention
# The per-thread stack size must be a multiple of 8k for AOLServer to run under MacOS X
- ns_param stacksize [expr 128 * 8192]
+ ns_param stacksize [expr {128 * 8192}]
#
# MIME types.
@@ -505,13 +505,13 @@
#
#---------------------------------------------------------------------
ns_section "ns/db/drivers"
-if { $database == "oracle" } {
+if { $database eq "oracle" } {
ns_param ora8 ${bindir}/ora8.so
} else {
ns_param postgres ${bindir}/nspostgres.so ;# Load PostgreSQL driver
}
-if { $database == "oracle" } {
+if { $database eq "oracle" } {
ns_section "ns/db/driver/ora8"
ns_param maxStringLogLength -1
ns_param LobBufferSize 32768
@@ -539,7 +539,7 @@
ns_param verbose $debug
ns_param extendedtableinfo true
ns_param logsqlerrors $debug
- if { $database == "oracle" } {
+ if { $database eq "oracle" } {
ns_param driver ora8
ns_param datasource {}
ns_param user $db_name
@@ -558,7 +558,7 @@
ns_param verbose $debug
ns_param extendedtableinfo true
ns_param logsqlerrors $debug
- if { $database == "oracle" } {
+ if { $database eq "oracle" } {
ns_param driver ora8
ns_param datasource {}
ns_param user $db_name
@@ -577,7 +577,7 @@
ns_param verbose $debug
ns_param extendedtableinfo true
ns_param logsqlerrors $debug
- if { $database == "oracle" } {
+ if { $database eq "oracle" } {
ns_param driver ora8
ns_param datasource {}
ns_param user $db_name
Index: openacs-4/etc/install/tcl/acs-lang-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/acs-lang-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/etc/install/tcl/acs-lang-procs.tcl 23 Oct 2003 12:35:01 -0000 1.4
+++ openacs-4/etc/install/tcl/acs-lang-procs.tcl 10 Jan 2007 21:21:59 -0000 1.5
@@ -12,7 +12,7 @@
Enables all locales, or a given list of locales, and
loads all message catalogs for those locales.
} {
- if { [empty_string_p $locales] } {
+ if { $locales eq "" } {
set locales [::twt::oacs::eval {db_list all_locales {select locale from ad_locales}}]
}
Index: openacs-4/etc/install/tcl/admin-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/admin-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/etc/install/tcl/admin-procs.tcl 12 Oct 2003 01:10:13 -0000 1.3
+++ openacs-4/etc/install/tcl/admin-procs.tcl 10 Jan 2007 21:21:59 -0000 1.4
@@ -83,7 +83,7 @@
::twt::do_request "$server_url/admin/site-map"
link follow ~u {parameter-set\?package%5fid=[0-9]+&package%5fkey=acs%2dkernel}
- if { ![string equal $param_section "acs-kernel"] } {
+ if { $param_section ne "acs-kernel" } {
link follow ~c "$param_section"
}
Index: openacs-4/etc/install/tcl/class-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/class-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/etc/install/tcl/class-procs.tcl 29 Oct 2003 14:38:09 -0000 1.6
+++ openacs-4/etc/install/tcl/class-procs.tcl 10 Jan 2007 21:21:59 -0000 1.7
@@ -79,7 +79,7 @@
set admin_rels [list dotlrn_ta_rel dotlrn_cadmin_rel dotlrn_ca_rel]
set admin_counter 0
for { set admin_counter 0 } \
- { [expr $admin_counter < 2 && $admin_counter < [llength $admin_users]] } \
+ { [expr {$admin_counter < 2 && $admin_counter < [llength $admin_users]}] } \
{ incr admin_counter } {
set admin_rel [::twt::get_random_items_from_list $admin_rels 1]
@@ -96,7 +96,7 @@
ad_proc ::twt::class::add_member { email rel_type } {
- if { [empty_string_p $email] } {
+ if { $email eq "" } {
return
}
Index: openacs-4/etc/install/tcl/dotlrn-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/dotlrn-procs.tcl,v
diff -u -r1.11 -r1.12
--- openacs-4/etc/install/tcl/dotlrn-procs.tcl 5 Jan 2004 12:26:55 -0000 1.11
+++ openacs-4/etc/install/tcl/dotlrn-procs.tcl 10 Jan 2007 21:21:59 -0000 1.12
@@ -265,5 +265,5 @@
::twt::assert_equals \
"Should be one less class to dergister from after deregistering" \
$deregister_count_after \
- [expr $deregister_count_before - 1]
+ [expr {$deregister_count_before - 1}]
}
Index: openacs-4/etc/install/tcl/twt-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/twt-procs.tcl,v
diff -u -r1.17 -r1.18
--- openacs-4/etc/install/tcl/twt-procs.tcl 26 Nov 2003 16:27:28 -0000 1.17
+++ openacs-4/etc/install/tcl/twt-procs.tcl 10 Jan 2007 21:21:59 -0000 1.18
@@ -36,7 +36,7 @@
}
ad_proc ::twt::assert_equals { explanation actual_value expected_value } {
- if { ![string equal $actual_value $expected_value] } {
+ if { $actual_value ne $expected_value } {
::twt::log_alert "Assertion \"$explanation\" failed: actual_value=\"$actual_value\", expected_value=\"$expected_value\""
}
}
@@ -98,7 +98,7 @@
set errno [catch {
array set link_array [link find -next ~u "$link_url_pattern"]} error]
- if { [string equal $errno "0"] } {
+ if {$errno eq "0"} {
set url $link_array(url)
lappend urls_list $url
@@ -158,7 +158,7 @@
Given an integer N, return an integer between 0 and N.
} {
- return [expr int([expr rand()] * $range)]
+ return [expr int([expr {rand()}] * $range)]
}
ad_proc ::twt::write_response_to_file { filename } {
@@ -252,7 +252,7 @@
@author Peter Marklund
} {
- if { ![empty_string_p $previous_url] } {
+ if { $previous_url ne "" } {
# For relative links to work, when we come back from the recursive crawling of a link, we need to make
# Tclwebtest understand that we are now relative to a different URL than the one last requested, namely
# relative to the URL of the page the link is on.
@@ -298,7 +298,7 @@
# Note that we are re-initializing start_url_absolute here since a trailing slash will be added if the URL is a directory
# and we need that to resolve relative URLs
if { [catch {set foobar [::twt::do_request $start_url_absolute]} errmsg] } {
- if { ![string equal "$previous_url" ""] } {
+ if { "$previous_url" ne "" } {
set previous_page_message " (link found on page $previous_url)"
} else {
set previous_page_message ""
@@ -324,16 +324,16 @@
# Don't revisit URL:s we have already tested
# Don't follow relative anchors on pages - can't get them to work with TclWebtest
- set new_url_p [expr [lsearch -exact $__url_history $absolute_url] == -1]
+ set new_url_p [expr {[lsearch -exact $__url_history $absolute_url] == -1}]
if { [string range $url 0 0] == "#" } {
set anchor_link_p 1
} else {
set anchor_link_p 0
}
#::twt::log "pm debug under_start_url_p - string first $start_url_absolute $absolute_url"
- set under_start_url_p [expr [string first $start_url_absolute $absolute_url] != -1]
+ set under_start_url_p [expr {[string first $start_url_absolute $absolute_url] != -1}]
- set visit_p [expr $new_url_p && !$anchor_link_p && $under_start_url_p]
+ set visit_p [expr {$new_url_p && !$anchor_link_p && $under_start_url_p}]
if { $visit_p } {
crawl_links -previous_url $start_url_absolute $url
}
@@ -353,7 +353,7 @@
set field_choices $current_field(choices)
set index 0
foreach field_choice $field_choices {
- if { [string equal $value [lindex $field_choice 0]] } {
+ if {$value eq [lindex $field_choice 0]} {
break
}
incr index
Index: openacs-4/etc/install/tcl/user-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/install/tcl/user-procs.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/etc/install/tcl/user-procs.tcl 2 Mar 2004 09:10:36 -0000 1.9
+++ openacs-4/etc/install/tcl/user-procs.tcl 10 Jan 2007 21:21:59 -0000 1.10
@@ -12,7 +12,7 @@
set user_emails [list]
foreach user_data [get_test_data] {
- if { [empty_string_p $type] || \
+ if { $type eq "" || \
[string equal -nocase [lindex $user_data 4] $type] } {
lappend user_emails [lindex $user_data 2]
@@ -32,7 +32,7 @@
ad_proc ::twt::user::get_password { email } {
- if { [string equal $email [::twt::config::admin_email]] } {
+ if {$email eq [::twt::config::admin_email]} {
return [::twt::config::admin_password]
} else {
global __demo_users_password
Index: openacs-4/etc/keepalive/keepalive-config.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/etc/keepalive/keepalive-config.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/etc/keepalive/keepalive-config.tcl 4 Jun 2006 00:45:19 -0000 1.3
+++ openacs-4/etc/keepalive/keepalive-config.tcl 10 Jan 2007 21:21:59 -0000 1.4
@@ -9,7 +9,7 @@
set servers_to_monitor {}
# How long the keepalive script waits until it attempts another restart
-set seconds_between_restarts [expr 10*60]
+set seconds_between_restarts [expr {10*60}]
# Who shall we email if the server is/cannot be restarted?
set mailto root
Index: openacs-4/packages/acs-admin/lib/become.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/lib/become.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/lib/become.tcl 13 Jan 2005 13:54:41 -0000 1.2
+++ openacs-4/packages/acs-admin/lib/become.tcl 10 Jan 2007 21:21:59 -0000 1.3
@@ -14,7 +14,7 @@
# Get the password and user ID
-if ![db_0or1row password "select password from users where user_id=$user_id"] {
+if {![db_0or1row password "select password from users where user_id=$user_id"]} {
ad_return_error "Couldn't find user $user_id" "Couldn't find user $user_id."
return
}
Index: openacs-4/packages/acs-admin/lib/password-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/lib/password-update.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/lib/password-update.tcl 13 Jan 2005 13:54:41 -0000 1.2
+++ openacs-4/packages/acs-admin/lib/password-update.tcl 10 Jan 2007 21:21:59 -0000 1.3
@@ -81,12 +81,12 @@
}
# If the account was closed, it might be open now
- if { [string equal [ad_conn account_status] "closed"] } {
+ if {[ad_conn account_status] eq "closed"} {
auth::verify_account_status
}
} -after_submit {
- if { [empty_string_p $return_url] } {
+ if { $return_url eq "" } {
set return_url [ad_pvt_home]
set pvt_home_name [ad_pvt_home_name]
set continue_label [_ acs-subsite.Continue_to_your_account]
Index: openacs-4/packages/acs-admin/lib/service-parameters.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/lib/service-parameters.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-admin/lib/service-parameters.tcl 23 Jan 2004 14:29:25 -0000 1.5
+++ openacs-4/packages/acs-admin/lib/service-parameters.tcl 10 Jan 2007 21:21:59 -0000 1.6
@@ -16,7 +16,7 @@
if { [file exists "[acs_package_root_dir $package_key]/www/"] } {
catch {
set url [apm_package_url_from_key $package_key]
- if { ![empty_string_p $url] && [file exists "[acs_package_root_dir $package_key]/www/admin/"] } {
+ if { $url ne "" && [file exists "[acs_package_root_dir $package_key]/www/admin/"] } {
set admin_url "${url}admin/"
}
if { [file exists "[acs_package_root_dir $package_key]/www/sitewide-admin/"] } {
@@ -30,7 +30,7 @@
}
set instance_name [lang::util::localize $instance_name]
- if { [empty_string_p $url] && [empty_string_p $admin_url] && [empty_string_p $param_url] } {
+ if { $url eq "" && $admin_url eq "" && $param_url eq "" } {
continue
}
}
Index: openacs-4/packages/acs-admin/tcl/apm-admin-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/tcl/apm-admin-procs.tcl,v
diff -u -r1.14 -r1.15
--- openacs-4/packages/acs-admin/tcl/apm-admin-procs.tcl 6 Jul 2006 11:29:01 -0000 1.14
+++ openacs-4/packages/acs-admin/tcl/apm-admin-procs.tcl 10 Jan 2007 21:21:59 -0000 1.15
@@ -22,7 +22,7 @@
lappend section_list [list $package_key $package_key [list "where" "section_name is null"]]
foreach section $sections {
incr i
- if { ![empty_string_p $section] } {
+ if { $section ne "" } {
lappend section_list [list "section_$i" $section [list "where" "section_name = '[db_quote $section]'"]]
}
}
@@ -63,7 +63,7 @@
}
set header [ad_header $title ""]
append body "$header\n"
- if {![empty_string_p $form]} {
+ if {$form ne ""} {
append body "<form $form>"
}
@@ -103,7 +103,7 @@
only the enable checkbox will be displayed, and the resulting page is expected to assume that enable also means install.
} {
- if {[empty_string_p $pkg_info_list]} {
+ if {$pkg_info_list eq ""} {
return ""
}
@@ -128,7 +128,7 @@
append widget " <tr valign=baseline bgcolor=[lindex $band_colors \
[expr { $counter % [llength $band_colors] }]]>"
- if { ![string compare [pkg_info_dependency_p $pkg_info] "t"]} {
+ if { [pkg_info_dependency_p $pkg_info] eq "t" } {
# Dependency passed.
if { $install_enable_p } {
@@ -162,7 +162,7 @@
<td>$package_rel_path</td>
<td><font color=green>Dependencies satisfied.</font></td>
</tr> "
- } elseif { ![string compare [pkg_info_dependency_p $pkg_info] "f"] } {
+ } elseif { [pkg_info_dependency_p $pkg_info] eq "f" } {
#Dependency failed.
if { $install_enable_p } {
append widget " <td align=center><input type=checkbox name=install value=\"$package_key\"
@@ -400,7 +400,7 @@
foreach { cur_work_dir cur_cvs_root cur_module } $checkout_list {
cd $cur_work_dir
- if { ![string equal $channel_tag($channel) HEAD] } {
+ if { $channel_tag($channel) ne "HEAD" } {
ns_log Debug "Repository: Checking out $cur_module from CVS:"
catch { exec $cvs_command -d $cur_cvs_root -z3 co -r $channel_tag($channel) $cur_module } output
ns_log Debug "Repository: [llength $output] files"
Index: openacs-4/packages/acs-admin/www/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/index.tcl,v
diff -u -r1.10 -r1.11
--- openacs-4/packages/acs-admin/www/index.tcl 31 Dec 2003 01:03:44 -0000 1.10
+++ openacs-4/packages/acs-admin/www/index.tcl 10 Jan 2007 21:21:59 -0000 1.11
@@ -13,7 +13,7 @@
array set node [site_node::get -node_id $node_id]
set parent_id $node(parent_id)
- while { ![empty_string_p $parent_id] } {
+ while { $parent_id ne "" } {
array unset node
array set node [site_node::get -node_id $parent_id]
set path_pretty "$node(instance_name) > $path_pretty"
Index: openacs-4/packages/acs-admin/www/send-email.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/send-email.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/www/send-email.tcl 30 Nov 2002 17:12:49 -0000 1.2
+++ openacs-4/packages/acs-admin/www/send-email.tcl 10 Jan 2007 21:21:59 -0000 1.3
@@ -23,13 +23,13 @@
return_url:onevalue
}
-if [catch {ns_sendmail $email $email_from $subject $message} errmsg] {
+if {[catch {ns_sendmail $email $email_from $subject $message} errmsg]} {
ad_return_error $error_subject "$error_message:
<blockquote><pre>[ad_quotehtml $errmsg]</pre></blockquote>"
ad_script_abort
}
-if { $show_sent_message_p != "t" } {
+if { $show_sent_message_p ne "t" } {
# Do not show any message. Just go to return url
ad_returnredirect $return_url
ad_script_abort
Index: openacs-4/packages/acs-admin/www/apm/build-repository.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/Attic/build-repository.tcl,v
diff -u -r1.15 -r1.16
--- openacs-4/packages/acs-admin/www/apm/build-repository.tcl 21 May 2004 11:00:29 -0000 1.15
+++ openacs-4/packages/acs-admin/www/apm/build-repository.tcl 10 Jan 2007 21:21:59 -0000 1.16
@@ -131,7 +131,7 @@
foreach { cur_work_dir cur_cvs_root cur_module } $checkout_list {
cd $cur_work_dir
- if { ![string equal $channel_tag($channel) HEAD] } {
+ if { $channel_tag($channel) ne "HEAD" } {
ns_write "<li>Checking out $cur_module from CVS:"
catch { exec $cvs_command -d $cur_cvs_root -z3 co -r $channel_tag($channel) $cur_module } output
ns_write " [llength $output] files\n"
Index: openacs-4/packages/acs-admin/www/apm/cvs-status.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/Attic/cvs-status.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-admin/www/apm/cvs-status.tcl 24 Sep 2003 18:23:36 -0000 1.3
+++ openacs-4/packages/acs-admin/www/apm/cvs-status.tcl 10 Jan 2007 21:21:59 -0000 1.4
@@ -37,7 +37,7 @@
global vc_file_props
if { [regexp {[a-zA-Z]} $vc_file_props(status)] } {
set status "$vc_file_props(status)"
- if { ![string compare $status "Up-to-date"] } {
+ if { $status eq "Up-to-date" } {
# It's up to date; don't print anything out.
continue
}
Index: openacs-4/packages/acs-admin/www/apm/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/index.tcl,v
diff -u -r1.21 -r1.22
--- openacs-4/packages/acs-admin/www/apm/index.tcl 17 May 2004 15:14:41 -0000 1.21
+++ openacs-4/packages/acs-admin/www/apm/index.tcl 10 Jan 2007 21:21:59 -0000 1.22
@@ -61,8 +61,8 @@
{ version_name "Ver." "" "" }
{
status "Status" "" {<td align=center> [eval {
- if { $installed_p == "t" } {
- if { $enabled_p == "t" } {
+ if { $installed_p eq "t" } {
+ if { $enabled_p eq "t" } {
set status "Enabled"
} else {
set status "Disabled"
@@ -82,7 +82,7 @@
set file_link_list [list]
lappend file_link_list "<a href=\"version-files?version_id=$version_id\">view files</a>"
- if { $installed_p == "t" && $enabled_p == "t" } {
+ if { $installed_p eq "t" && $enabled_p eq "t" } {
if { ! [ad_parameter -package_id [ad_acs_kernel_id] PerformanceModeP request-processor 1] } {
lappend file_link_list "<a href=\"package-watch?package_key=$package_key\">watch all files</a>"
}
@@ -139,7 +139,7 @@
append body "<h3>Watches</h3><ul>
<li><a href=\"file-watch-cancel\">Stop watching all files</a></li><br />"
foreach file [lsort $watch_files] {
- if { [string compare $file "."] } {
+ if {$file ne "." } {
append body "<li>$file (<a href=\"file-watch-cancel?watch_file=[ns_urlencode $file]\">stop watching this file</a>)\n"
}
}
Index: openacs-4/packages/acs-admin/www/apm/package-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/package-delete.tcl,v
diff -u -r1.7 -r1.8
--- openacs-4/packages/acs-admin/www/apm/package-delete.tcl 1 Jun 2003 18:31:08 -0000 1.7
+++ openacs-4/packages/acs-admin/www/apm/package-delete.tcl 10 Jan 2007 21:21:59 -0000 1.8
@@ -47,7 +47,7 @@
where package_key = :package_key
}]
-if { [string equal $initial_install_p "t"] } {
+if {$initial_install_p eq "t"} {
set kernel_deletion_warning "
<p>
You are about to delete package <code>$package_key</code> which is part of the <b>OpenACS core</b>
@@ -57,7 +57,7 @@
set kernel_deletion_warning ""
}
-if { ![empty_string_p $dependency_warning_text] || ![empty_string_p $kernel_deletion_warning] } {
+if { $dependency_warning_text ne "" || $kernel_deletion_warning ne "" } {
set warning_text "
<p>
<b><font color=\"red\">WARNING</font></b>
@@ -83,7 +83,7 @@
</tr>"
}
-if {![empty_string_p $file_list]} {
+if {$file_list ne ""} {
set file_list "
We recommend sourcing all of the drop scripts for the package. Be aware that this will
erase all data associated with this package from the database.
Index: openacs-4/packages/acs-admin/www/apm/package-load-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/package-load-2.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-admin/www/apm/package-load-2.tcl 10 Sep 2002 22:21:59 -0000 1.3
+++ openacs-4/packages/acs-admin/www/apm/package-load-2.tcl 10 Jan 2007 21:21:59 -0000 1.4
@@ -13,8 +13,8 @@
} -validate {
url_xor_file_path {
- if {([empty_string_p $url] && [empty_string_p $file_path]) ||
- (![empty_string_p $url] && ![empty_string_p $file_path]) } {
+ if {($url eq "" && $file_path eq "") ||
+ ($url ne "" && $file_path ne "") } {
ad_complain
}
}
@@ -30,9 +30,9 @@
ad_return_top_of_page "[apm_header -form "package-load" [list "package-load" "Load a New Package"] "View Package Contents"]
"
-if {[empty_string_p $file_path]} {
+if {$file_path eq ""} {
- if {[string range $url 0 6] == "http://"} {
+ if {[string range $url 0 6] eq "http://"} {
set url [string range $url 7 end]
}
@@ -68,14 +68,14 @@
}
ns_log Debug "APM: Loading $file_path"
# If file_path ends in .apm, then load the single package.
-if { ![string compare [string range $file_path [expr [string length $file_path] -3] end] "apm"] } {
+if { ![string compare [string range $file_path [expr {[string length $file_path] -3}] end] "apm"] } {
apm_load_apm_file -callback apm_ns_write_callback $file_path
} else {
# See if this is a directory.
if { [file isdirectory $file_path] } {
#Find all the .APM and load them.
set apm_file_list [glob -nocomplain "$file_path/*.apm"]
- if {[empty_string_p $apm_file_list]} {
+ if {$apm_file_list eq ""} {
ns_write "The directory specified, <code>$file_path</code>, does not contain any APM files. Please <a href=\"package-load\">try again</a>.[ad_footer]"
return
} else {
Index: openacs-4/packages/acs-admin/www/apm/packages-install-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/packages-install-2.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-admin/www/apm/packages-install-2.tcl 20 Apr 2005 11:48:56 -0000 1.9
+++ openacs-4/packages/acs-admin/www/apm/packages-install-2.tcl 10 Jan 2007 21:21:59 -0000 1.10
@@ -84,7 +84,7 @@
[ad_footer]
"
-} elseif { ([lindex $dependency_results 0] == 1) || ![string compare $force_p "t"]} {
+} elseif { ([lindex $dependency_results 0] == 1) || $force_p eq "t" } {
### Check passed! Initiate install.
# We use client properties to pass along this information as it is fairly large.
Index: openacs-4/packages/acs-admin/www/apm/packages-install-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/packages-install-3.tcl,v
diff -u -r1.12 -r1.13
--- openacs-4/packages/acs-admin/www/apm/packages-install-3.tcl 12 Mar 2004 19:19:45 -0000 1.12
+++ openacs-4/packages/acs-admin/www/apm/packages-install-3.tcl 10 Jan 2007 21:21:59 -0000 1.13
@@ -55,7 +55,7 @@
set sql_file_list [concat $sql_file_list $data_model_files]
- if {![empty_string_p $data_model_files]} {
+ if {$data_model_files ne ""} {
foreach file $data_model_files {
set path [lindex $file 0]
set file_type [lindex $file 1]
@@ -90,7 +90,7 @@
ad_set_client_property -clob t apm sql_file_paths $sql_file_list
-if {[empty_string_p $sql_file_list]} {
+if {$sql_file_list eq ""} {
ad_returnredirect packages-install-4
ad_script_abort
}
Index: openacs-4/packages/acs-admin/www/apm/packages-install-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/packages-install-4.tcl,v
diff -u -r1.15 -r1.16
--- openacs-4/packages/acs-admin/www/apm/packages-install-4.tcl 4 Jun 2006 00:45:20 -0000 1.15
+++ openacs-4/packages/acs-admin/www/apm/packages-install-4.tcl 10 Jan 2007 21:21:59 -0000 1.16
@@ -53,14 +53,14 @@
set data_model_files [list]
# Find the correct data model files for this package.
foreach file $sql_files {
- if {![string compare [lindex $file 2] $package_key]} {
+ if {[lindex $file 2] eq $package_key } {
# Pass on the file path and its type.
lappend data_model_files $file
}
}
# Mount path of package
- if { [lsearch $mount_p $package_key] != -1 && [info exists mount_path($package_key)] && ![empty_string_p $mount_path($package_key)] } {
+ if { [lsearch $mount_p $package_key] != -1 && [info exists mount_path($package_key)] && $mount_path($package_key) ne "" } {
set selected_mount_path $mount_path($package_key)
} else {
set selected_mount_path ""
@@ -69,7 +69,7 @@
# Install the packages.
ns_log Debug "APM: Installing package at $package_path."
- set enable_p [expr [lsearch -exact $pkg_enable_list $package_key] != -1]
+ set enable_p [expr {[lsearch -exact $pkg_enable_list $package_key] != -1}]
set version_id [apm_package_install \
-enable=$enable_p \
Index: openacs-4/packages/acs-admin/www/apm/packages-install.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/packages-install.tcl,v
diff -u -r1.18 -r1.19
--- openacs-4/packages/acs-admin/www/apm/packages-install.tcl 26 Sep 2003 07:50:33 -0000 1.18
+++ openacs-4/packages/acs-admin/www/apm/packages-install.tcl 10 Jan 2007 21:21:59 -0000 1.19
@@ -66,7 +66,7 @@
ns_write "Done.<p>
"
-if { [empty_string_p $spec_files] } {
+if { $spec_files eq "" } {
# No spec files to work with.
ns_write "
<h2>No New Packages to Install</h2><p>
@@ -85,12 +85,12 @@
<script language=javascript>
function uncheckAll() {
- for (var i = 0; i < [expr [llength $spec_files] ]; ++i)
+ for (var i = 0; i < [expr {[llength $spec_files] }]; ++i)
document.forms\[0\].elements\[i\].checked = false;
this.href='';
}
function checkAll() {
- for (var i = 0; i < [expr [llength $spec_files] ]; ++i)
+ for (var i = 0; i < [expr {[llength $spec_files] }]; ++i)
document.forms\[0\].elements\[i\].checked = true;
this.href='';
}
@@ -131,7 +131,7 @@
set widget [apm_package_selection_widget $pkg_info_list]
}
- if {[empty_string_p $widget]} {
+ if {$widget eq ""} {
ns_write "There are no new packages available.<p>
[ad_footer]"
ad_script_abort
@@ -143,7 +143,7 @@
</form>
"
- if {![empty_string_p $errors]} {
+ if {$errors ne ""} {
ns_write "The following errors were generated
<ul>
$errors
Index: openacs-4/packages/acs-admin/www/apm/parameter-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/parameter-add-2.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-admin/www/apm/parameter-add-2.tcl 17 Sep 2003 18:35:47 -0000 1.6
+++ openacs-4/packages/acs-admin/www/apm/parameter-add-2.tcl 10 Jan 2007 21:21:59 -0000 1.7
@@ -17,7 +17,7 @@
{max_n_values:integer 1}
} -validate {
datatype_type_ck {
- if {$datatype != "number" && $datatype != "string"} {
+ if {$datatype ne "number" && $datatype ne "string"} {
ad_complain
}
}
@@ -52,7 +52,7 @@
# LARS hack
set sections [lindex [lindex [apm_parameter_section_slider $package_key] 0] 3]
foreach section $sections {
- if { [string equal $section_name [lindex $section 1]] } {
+ if {$section_name eq [lindex $section 1]} {
set section_name [lindex $section 0]
break
}
Index: openacs-4/packages/acs-admin/www/apm/parameter-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/parameter-delete.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-admin/www/apm/parameter-delete.tcl 21 Jul 2005 15:51:32 -0000 1.5
+++ openacs-4/packages/acs-admin/www/apm/parameter-delete.tcl 10 Jan 2007 21:21:59 -0000 1.6
@@ -19,7 +19,7 @@
# LARS hack
set sections [lindex [lindex [apm_parameter_section_slider $package_key] 0] 3]
foreach section $sections {
- if { [string equal $section_name [lindex $section 1]] } {
+ if {$section_name eq [lindex $section 1]} {
set section_name [lindex $section 0]
break
}
Index: openacs-4/packages/acs-admin/www/apm/parameter-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/parameter-edit-2.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-admin/www/apm/parameter-edit-2.tcl 17 Sep 2003 18:35:47 -0000 1.4
+++ openacs-4/packages/acs-admin/www/apm/parameter-edit-2.tcl 10 Jan 2007 21:21:59 -0000 1.5
@@ -17,7 +17,7 @@
{max_n_values:integer 1}
} -validate {
datatype_type_ck {
- if {$datatype != "number" && $datatype != "string"} {
+ if {$datatype ne "number" && $datatype ne "string"} {
ad_complain
}
}
@@ -41,7 +41,7 @@
# LARS hack
set sections [lindex [lindex [apm_parameter_section_slider $package_key] 0] 3]
foreach section $sections {
- if { [string equal $section_name [lindex $section 1]] } {
+ if {$section_name eq [lindex $section 1]} {
set section_name [lindex $section 0]
break
}
Index: openacs-4/packages/acs-admin/www/apm/version-callback-add-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/version-callback-add-edit.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-admin/www/apm/version-callback-add-edit.tcl 17 Sep 2003 11:20:30 -0000 1.6
+++ openacs-4/packages/acs-admin/www/apm/version-callback-add-edit.tcl 10 Jan 2007 21:21:59 -0000 1.7
@@ -15,7 +15,7 @@
set return_url "version-callbacks?[export_vars { version_id }]"
# Set default values for type and proc name
-if { [empty_string_p $type] } {
+if { $type eq "" } {
# We are in add mode
set edit_mode_p 0
set unused_types [apm_unused_callback_types -version_id $version_id]
Index: openacs-4/packages/acs-admin/www/apm/version-dependencies.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/version-dependencies.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/www/apm/version-dependencies.tcl 10 Sep 2002 22:21:59 -0000 1.2
+++ openacs-4/packages/acs-admin/www/apm/version-dependencies.tcl 10 Jan 2007 21:21:59 -0000 1.3
@@ -60,7 +60,7 @@
} else {
doc_body_append "<li>This package does not $dependency_type any services.\n"
}
- if { $installed_p == "t" } {
+ if { $installed_p eq "t" } {
doc_body_append "<li><a href=\"version-dependency-add?[export_url_vars version_id dependency_type]\">Add a service ${dependency_type}d by this package</a>\n"
}
doc_body_append "</ul>\n"
Index: openacs-4/packages/acs-admin/www/apm/version-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/version-edit-2.tcl,v
diff -u -r1.10 -r1.11
--- openacs-4/packages/acs-admin/www/apm/version-edit-2.tcl 26 Apr 2004 18:50:47 -0000 1.10
+++ openacs-4/packages/acs-admin/www/apm/version-edit-2.tcl 10 Jan 2007 21:21:59 -0000 1.11
@@ -31,7 +31,7 @@
if { [info exists attribute(validation_proc)] } {
set attribute_error [eval $attribute(validation_proc) $attribute_value]
- if { ![empty_string_p $attribute_error] } {
+ if { $attribute_error ne "" } {
ad_return_complaint 1 $attribute_error
}
}
@@ -46,15 +46,15 @@
# Figure out if we're changing version
db_1row old_version_info {}
-set version_changed_p [expr ![string equal $version_name $old_version_name]]
+set version_changed_p [expr {$version_name ne $old_version_name }]
-if { [string equal $old_version_name $version_name] } {
+if {$old_version_name eq $version_name} {
# The version name didn't change, so don't attempt to upgrade
set upgrade_p 0
}
# The user has to update the URL if he changes the name.
-if { $version_changed_p && [string equal $version_uri $old_version_uri] } {
+if { $version_changed_p && $version_uri eq $old_version_uri } {
ad_return_complaint 1 {You have changed the version number but not the version URL. When creating
a package for a new version, you must select a new URL for the version.}
}
Index: openacs-4/packages/acs-admin/www/apm/version-files.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/version-files.tcl,v
diff -u -r1.14 -r1.15
--- openacs-4/packages/acs-admin/www/apm/version-files.tcl 31 Oct 2003 12:11:28 -0000 1.14
+++ openacs-4/packages/acs-admin/www/apm/version-files.tcl 10 Jan 2007 21:21:59 -0000 1.15
@@ -33,7 +33,7 @@
set db_type [apm_guess_db_type $package_key $path]
set db_pretty_name $db_type
set file_type [apm_guess_file_type $package_key $path]
- if { [empty_string_p $file_type] } {
+ if { $file_type eq "" } {
set file_type "?"
}
set file_pretty_name $file_type
@@ -44,7 +44,7 @@
# we wrote out.
set components [split $path "/"]
for { set i 0 } { $i < [llength $components] - 1 && $i < [llength $last_components] - 1 } { incr i } {
- if { [string compare [lindex $components $i] [lindex $last_components $i]] } {
+ if {[lindex $components $i] ne [lindex $last_components $i] } {
break
}
}
@@ -55,7 +55,7 @@
for { set j 0 } { $j < $i } { incr j } {
append body " "
}
- if { $installed_p == "f" || [file exists "[acs_package_root_dir $package_key]/$path"] || $i < [llength $components] - 1} {
+ if { $installed_p eq "f" || [file exists "[acs_package_root_dir $package_key]/$path"] || $i < [llength $components] - 1} {
# Either we're not looking at an installed package, or the file still exists,
# so don't use <strike> when writing the name.
append body [lindex $components $i]
@@ -74,7 +74,7 @@
append body "<td width=40> </td><td>$file_pretty_name</td><td width=40> </td><td>$db_pretty_name</td>
<td width=40> </td>"
- if { $installed_p == "t" } {
+ if { $installed_p eq "t" } {
set server_rel_path "packages/$package_key/$path"
if { [apm_file_watchable_p $server_rel_path] } {
if { [nsv_exists apm_reload_watch $server_rel_path] } {
@@ -101,35 +101,35 @@
set last_components $components
}
-if { [string equal $counter 0] } {
+if {$counter eq "0"} {
append body "<tr><td>This package does not contain any registered files.</td></tr>\n"
}
append body "</table>
</blockquote>
"
-if { $installed_p == "t" } {
+if { $installed_p eq "t" } {
append body "<ul>
<li><a href=\"package-watch?[export_vars -url {package_key return_url}]\">watch all files</a></li>
<li><a href=\"package-watch-cancel?[export_vars -url {package_key return_url}]\">cancel all watches</a></li>"
- if { [empty_string_p $distribution_uri] } {
+ if { $distribution_uri eq "" } {
append body "
<p>
<!--li><a href=\"version-tag?version_id=$version_id\">Create a CVS tag for this version in each file</a-->"
}
- if {$tagged_p == "t"} {
+ if {$tagged_p eq "t"} {
append body "
<li><a href=\"archive/[file tail $version_uri]?version_id=$version_id\">Download a tarball from the package archive</a>"
}
append body "</ul>"
} elseif { [info exists tagged_p] } {
- if { $tagged_p == "t" } {
+ if { $tagged_p eq "t" } {
append body "<ul>
<li><a href=\"archive/[file tail $version_uri]?version_id=$version_id\">Download a tarball from the package archive</a>
</ul>
Index: openacs-4/packages/acs-admin/www/apm/version-i18n-process-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/version-i18n-process-2.tcl,v
diff -u -r1.14 -r1.15
--- openacs-4/packages/acs-admin/www/apm/version-i18n-process-2.tcl 11 Dec 2003 21:39:45 -0000 1.14
+++ openacs-4/packages/acs-admin/www/apm/version-i18n-process-2.tcl 10 Jan 2007 21:21:59 -0000 1.15
@@ -104,7 +104,7 @@
append processing_html_result "<h3>Message tag replacements for $file</h3>"
set number_of_replacements [lang::util::replace_temporary_tags_with_lookups $file]
- set total_number_of_replacements [expr $total_number_of_replacements + $number_of_replacements]
+ set total_number_of_replacements [expr {$total_number_of_replacements + $number_of_replacements}]
append processing_html_result "Did $number_of_replacements replacements, see the log file for details"
}
Index: openacs-4/packages/acs-admin/www/apm/version-i18n.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/version-i18n.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-admin/www/apm/version-i18n.tcl 20 Apr 2004 21:12:28 -0000 1.9
+++ openacs-4/packages/acs-admin/www/apm/version-i18n.tcl 10 Jan 2007 21:21:59 -0000 1.10
@@ -62,7 +62,7 @@
set add_file_p 1
# If we are showing adp:s and we are only showing adp:s with texts to translate, check if
# this file has any texts
- if { [string equal $file_type "adp"] && $only_text_p } {
+ if { $file_type eq "adp" && $only_text_p } {
if { $number_of_text_snippets == "0" } {
set add_file_p 0
}
@@ -95,7 +95,7 @@
-values $adp_preselect_list
set action_label "Action to take on files"
-if { [string equal $file_type adp] } {
+if {$file_type eq "adp"} {
element create file_list_form file_action \
-datatype text \
-widget checkbox \
Index: openacs-4/packages/acs-admin/www/apm/version-parameter-values.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/Attic/version-parameter-values.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/www/apm/version-parameter-values.tcl 10 Sep 2002 22:21:59 -0000 1.2
+++ openacs-4/packages/acs-admin/www/apm/version-parameter-values.tcl 10 Jan 2007 21:21:59 -0000 1.3
@@ -29,7 +29,7 @@
order by element_name
} {
- if $first_iteration {
+ if {$first_iteration} {
doc_body_append "
<tr>
<th>Parameter</th>
Index: openacs-4/packages/acs-admin/www/apm/version-parameters.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/version-parameters.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-admin/www/apm/version-parameters.tcl 17 Sep 2003 18:35:47 -0000 1.5
+++ openacs-4/packages/acs-admin/www/apm/version-parameters.tcl 10 Jan 2007 21:21:59 -0000 1.6
@@ -49,14 +49,14 @@
<blockquote>
"
-if { ![empty_string_p $dimensional_list] } {
+if { $dimensional_list ne "" } {
append body "[ad_dimensional $dimensional_list]<p>"
}
# LARS hack
set sections [lindex [lindex $dimensional_list 0] 3]
foreach section $sections {
- if { [string equal $section_name [lindex $section 0]] } {
+ if {$section_name eq [lindex $section 0]} {
set section_name [lindex $section 1]
break
}
Index: openacs-4/packages/acs-admin/www/apm/version-tag.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/Attic/version-tag.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-admin/www/apm/version-tag.tcl 11 Dec 2003 21:39:45 -0000 1.3
+++ openacs-4/packages/acs-admin/www/apm/version-tag.tcl 10 Jan 2007 21:21:59 -0000 1.4
@@ -14,7 +14,7 @@
from apm_package_version_info where version_id = :version_id
}
-if { $installed_p == "f" } {
+if { $installed_p eq "f" } {
ad_return_complaint 1 "<li>The selected version is not installed"
return
}
Index: openacs-4/packages/acs-admin/www/apm/version-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/version-view.tcl,v
diff -u -r1.18 -r1.19
--- openacs-4/packages/acs-admin/www/apm/version-view.tcl 26 Apr 2004 18:50:47 -0000 1.18
+++ openacs-4/packages/acs-admin/www/apm/version-view.tcl 10 Jan 2007 21:21:59 -0000 1.19
@@ -35,7 +35,7 @@
where rownum = 1
}
-if { [empty_string_p $vendor] } {
+if { $vendor eq "" } {
set vendor $vendor_uri
}
foreach field { summary description release_date vendor } {
@@ -60,7 +60,7 @@
lappend prompts $status
} elseif { $installed_version_id == $version_id } {
set status "This version of the package is installed"
- if { $enabled_p == "t" } {
+ if { $enabled_p eq "t" } {
append status " and enabled."
set can_disable_p 1
} else {
@@ -77,7 +77,7 @@
if { ![info exists data_model_installed_version] } {
set data_model_status " No version of the data model for this package has been loaded."
-} elseif { [string compare $data_model_installed_version $version_name] } {
+} elseif {$data_model_installed_version ne $version_name } {
set data_model_status " The data model for version $data_model_installed_version of this package has been
loaded."
} else {
@@ -96,7 +96,7 @@
db_foreach apm_all_owners {
select owner_uri, owner_name from apm_package_owners where version_id = :version_id
} {
- if { [empty_string_p $owner_uri] } {
+ if { $owner_uri eq "" } {
lappend owners $owner_name
} else {
lappend owners "$owner_name (<a href=\"$owner_uri\">$owner_uri</a>)"
@@ -136,7 +136,7 @@
"
set supported_databases_list [apm_package_supported_databases $package_key]
-if { [empty_string_p $supported_databases_list] } {
+if { $supported_databases_list eq "" } {
set supported_databases "none specified"
} else {
set supported_databases [join $supported_databases_list ", "]
@@ -171,24 +171,24 @@
<tr valign=baseline><th align=left>Version URL:</th><td><a href=\"$version_uri\">$version_uri</a></td></th></tr>
<tr valign=baseline><th align=left>Distribution File:</th><td>"
-if { ![empty_string_p $tarball_length] && $tarball_length > 0 } {
+if { $tarball_length ne "" && $tarball_length > 0 } {
append body "<a href=\"packages/[file tail $version_uri]?version_id=$version_id\">[format "%.1f" [expr { $tarball_length / 1024.0 }]]KB</a> "
- if { [empty_string_p $distribution_uri] } {
+ if { $distribution_uri eq "" } {
append body "(generated on this system"
- if { ![empty_string_p $distribution_date] } {
+ if { $distribution_date ne "" } {
append body " on $distribution_date"
}
append body ")"
} else {
append body "(downloaded from $distribution_uri"
- if { ![empty_string_p $distribution_date] } {
+ if { $distribution_date ne "" } {
append body " on $distribution_date"
}
append body ")"
}
} else {
append body "None available"
- if { $installed_p == "t" } {
+ if { $installed_p eq "t" } {
append body " (<a href=\"version-generate-tarball?version_id=$version_id\">generate one now</a> from the filesystem)"
}
}
@@ -224,15 +224,15 @@
"
if { ![info exists installed_version_id] || $installed_version_id == $version_id && \
- [empty_string_p $distribution_uri] } {
+ $distribution_uri eq "" } {
# As long as there isn't a different installed version, and this package is being
# generated locally, allow the user to write a specification file for this version
# of the package.
append body "<li><a href=\"version-generate-info?[export_vars { version_id }]&write_p=1\">Write an XML package specification to the <tt>packages/$package_key/$package_key.info</tt> file</a>\n"
}
-if { $installed_p == "t" } {
- if { [empty_string_p $distribution_uri] } {
+if { $installed_p eq "t" } {
+ if { $distribution_uri eq "" } {
# The distribution tarball was either (a) never generated, or (b) generated on this
# system. Allow the user to make a tarball based on files in the filesystem.
append body "<p><li><a href=\"version-generate-tarball?[export_vars { version_id }]\">Generate a distribution file for this package from the filesystem</a>\n"
@@ -249,7 +249,7 @@
append body "<p>"
- if { $installed_p == "t" } {
+ if { $installed_p eq "t" } {
append body "
<li><a href=\"package-delete?[export_vars { version_id }]\">Uninstall this package from your system.</a> (be very careful!)\n"
Index: openacs-4/packages/acs-admin/www/apm/write-all-specs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/apm/write-all-specs.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-admin/www/apm/write-all-specs.tcl 10 Mar 2003 19:59:31 -0000 1.5
+++ openacs-4/packages/acs-admin/www/apm/write-all-specs.tcl 10 Jan 2007 21:21:59 -0000 1.6
@@ -20,7 +20,7 @@
and v.package_key = t.package_key
order by upper(pretty_name)
} {
- if { [empty_string_p $distribution_uri] } {
+ if { $distribution_uri eq "" } {
ns_log Debug "Generating package specificaiton for $package_key"
ns_write "<li>$pretty_name $version_name... "
if { [catch {
Index: openacs-4/packages/acs-admin/www/auth/authority-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/auth/authority-delete.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/www/auth/authority-delete.tcl 11 Sep 2003 09:21:27 -0000 1.2
+++ openacs-4/packages/acs-admin/www/auth/authority-delete.tcl 10 Jan 2007 21:22:00 -0000 1.3
@@ -8,7 +8,7 @@
}
# Cannot delete local authority
-if { [string equal $authority_id [auth::authority::local]] } {
+if {$authority_id eq [auth::authority::local]} {
ad_return_error "Cannot delete local authority" "The system requires the local authority to operate."
}
Index: openacs-4/packages/acs-admin/www/auth/authority-registration-select.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/auth/authority-registration-select.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-admin/www/auth/authority-registration-select.tcl 12 Sep 2003 14:33:23 -0000 1.1
+++ openacs-4/packages/acs-admin/www/auth/authority-registration-select.tcl 10 Jan 2007 21:22:00 -0000 1.2
@@ -9,7 +9,7 @@
# Check that the authority has a register implementation
auth::authority::get -authority_id $authority_id -array authority
-if { [empty_string_p $authority(register_impl_id)] } {
+if { $authority(register_impl_id) eq "" } {
ad_return_error "No register driver" "The authority $authority(pretty_name) does not have a register driver and cannot register users"
}
Index: openacs-4/packages/acs-admin/www/auth/authority-set-enabled-p.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/auth/authority-set-enabled-p.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/www/auth/authority-set-enabled-p.tcl 11 Sep 2003 09:21:27 -0000 1.2
+++ openacs-4/packages/acs-admin/www/auth/authority-set-enabled-p.tcl 10 Jan 2007 21:22:00 -0000 1.3
@@ -12,7 +12,7 @@
# Make sure we are not shutting out all site-wide-admins from the system
set allowed_p 1
-if { [string equal $enabled_p "f"] && ![auth::can_admin_system_without_authority_p -authority_id $authority_id]} {
+if { $enabled_p eq "f" && ![auth::can_admin_system_without_authority_p -authority_id $authority_id]} {
set allowed_p 0
}
Index: openacs-4/packages/acs-admin/www/auth/authority-set-sort-order.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/auth/authority-set-sort-order.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/www/auth/authority-set-sort-order.tcl 22 Oct 2003 12:47:25 -0000 1.2
+++ openacs-4/packages/acs-admin/www/auth/authority-set-sort-order.tcl 10 Jan 2007 21:22:00 -0000 1.3
@@ -16,7 +16,7 @@
where authority_id = :authority_id
}
-if { $direction == "up" } {
+if { $direction eq "up" } {
db_transaction {
# Increase next authority's sort_order by one
@@ -36,7 +36,7 @@
}
}
-} elseif { $direction == "down"} {
+} elseif { $direction eq "down"} {
db_transaction {
# Decrease previous authority's sort_order by one
Index: openacs-4/packages/acs-admin/www/auth/authority.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/auth/authority.tcl,v
diff -u -r1.19 -r1.20
--- openacs-4/packages/acs-admin/www/auth/authority.tcl 11 Dec 2003 21:39:45 -0000 1.19
+++ openacs-4/packages/acs-admin/www/auth/authority.tcl 10 Jan 2007 21:22:00 -0000 1.20
@@ -112,7 +112,7 @@
# For the local authority we allow only limited editing
# Is this the local authority?
set local_authority_p 0
-if { $authority_exists_p && [string equal $authority_id [auth::authority::local]] } {
+if { $authority_exists_p && $authority_id eq [auth::authority::local] } {
set local_authority_p 1
}
@@ -162,7 +162,7 @@
# Set the value of the help_contact_text element - both contents and format attributes
set help_contact_text [template::util::richtext::create]
set help_contact_text [template::util::richtext::set_property contents $help_contact_text $element_array(help_contact_text)]
- if { [empty_string_p $element_array(help_contact_text_format)] } {
+ if { $element_array(help_contact_text_format) eq "" } {
set element_array(help_contact_text_format) "text/enhanced"
}
set help_contact_text [template::util::richtext::set_property format $help_contact_text $element_array(help_contact_text_format)]
@@ -190,7 +190,7 @@
} -edit_data {
foreach var_name [template::form::get_elements -no_api authority] {
- if { ![string equal $var_name "authority_id"] } {
+ if { $var_name ne "authority_id" } {
set element_array($var_name) [set $var_name]
}
}
@@ -249,7 +249,7 @@
}
}
-set display_batch_history_p [expr $authority_exists_p && [string equal $ad_form_mode "display"]]
+set display_batch_history_p [expr {$authority_exists_p && $ad_form_mode eq "display"}]
if { $display_batch_history_p } {
db_multirow -extend {
@@ -272,7 +272,7 @@
set actions_per_minute {}
if { $run_time_seconds > 0 && $num_actions > 0 } {
- set actions_per_minute [expr round(60.0 * $num_actions / $run_time_seconds)]
+ set actions_per_minute [expr {round(60.0 * $num_actions / $run_time_seconds)}]
}
set run_time [util::interval_pretty -seconds $run_time_seconds]
}
Index: openacs-4/packages/acs-admin/www/auth/batch-action.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/auth/batch-action.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-admin/www/auth/batch-action.tcl 17 Oct 2003 11:08:52 -0000 1.4
+++ openacs-4/packages/acs-admin/www/auth/batch-action.tcl 10 Jan 2007 21:22:00 -0000 1.5
@@ -48,11 +48,11 @@
# Prettify certain elements
if { [regexp {_p$} $element_name] } {
set $element_name [ad_decode $batch_action($element_name) "t" "Yes" "No"]
- } elseif { [string equal $element_name "user_id"] && ![empty_string_p $batch_action($element_name)] } {
+ } elseif { $element_name eq "user_id" && $batch_action($element_name) ne "" } {
if { [catch {set $element_name [acs_community_member_link -user_id $batch_action($element_name)]}] } {
set $element_name $batch_action($element_name)
}
- } elseif { [string equal $element_name "element_messages"] && ![empty_string_p $batch_action($element_name)] } {
+ } elseif { $element_name eq "element_messages" && $batch_action($element_name) ne "" } {
array set messages_array $batch_action($element_name)
append $element_name "<ul>"
foreach message_name [array names messages_array] {
Index: openacs-4/packages/acs-admin/www/auth/batch-job.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/auth/batch-job.tcl,v
diff -u -r1.10 -r1.11
--- openacs-4/packages/acs-admin/www/auth/batch-job.tcl 29 Oct 2003 13:29:22 -0000 1.10
+++ openacs-4/packages/acs-admin/www/auth/batch-job.tcl 10 Jan 2007 21:22:00 -0000 1.11
@@ -72,7 +72,7 @@
# Make certain columns pretty for display
if { [regexp {_p$} $element_name] } {
set $element_name [ad_decode $batch_job($element_name) "t" "Yes" "No"]
- } elseif { [string equal $element_name "creation_user"] && ![empty_string_p $batch_job($element_name)] } {
+ } elseif { $element_name eq "creation_user" && $batch_job($element_name) ne "" } {
set $element_name [acs_community_member_link -user_id $batch_job($element_name)]
} else {
set $element_name [ad_quotehtml $batch_job($element_name)]
@@ -153,7 +153,7 @@
set entry_url [export_vars -base batch-action { entry_id }]
# Use message and element_messages to display one short message in the table
- if { ![empty_string_p $message] } {
+ if { $message ne "" } {
set short_message $message
} elseif { [llength $element_messages] == 2 } {
# Only one element message - use it
@@ -166,7 +166,7 @@
}
set short_message [string_truncate -len 75 -- $short_message]
- if { $user_exists_p && ![empty_string_p $user_id] } {
+ if { $user_exists_p && $user_id ne "" } {
set user_url [acs_community_member_admin_url -user_id $user_id]
} else {
set user_url {}
Index: openacs-4/packages/acs-admin/www/auth/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/auth/index.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-admin/www/auth/index.tcl 23 Oct 2003 10:40:29 -0000 1.6
+++ openacs-4/packages/acs-admin/www/auth/index.tcl 10 Jan 2007 21:22:00 -0000 1.7
@@ -128,10 +128,10 @@
set sort_order_url_up "authority-set-sort-order?[export_vars { authority_id {direction up} }]"
set sort_order_url_down "authority-set-sort-order?[export_vars { authority_id {direction down} }]"
- if { [string equal $authority_id $register_authority_id] } {
+ if {$authority_id eq $register_authority_id} {
# The authority is selected as register authority
set registration_status "selected"
- } elseif { ![empty_string_p $reg_impl] } {
+ } elseif { $reg_impl ne "" } {
# The authority can be selected as register authority
set registration_status "can_select"
set registration_url [export_vars -base authority-registration-select { authority_id }]
Index: openacs-4/packages/acs-admin/www/cache/flush-cache.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/cache/flush-cache.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/www/cache/flush-cache.tcl 8 Jan 2004 15:45:04 -0000 1.2
+++ openacs-4/packages/acs-admin/www/cache/flush-cache.tcl 10 Jan 2007 21:22:00 -0000 1.3
@@ -5,13 +5,13 @@
{return_url "."}
}
-if [string equal $suffix "util_memoize"] {
+if {$suffix eq "util_memoize"} {
foreach name [ns_cache names util_memoize] {
ns_cache flush util_memoize $name
}
} else {
#ns_return 200 text/html $suffix
- if [catch { util_memoize_flush_cache $suffix } errmsg] {
+ if {[catch { util_memoize_flush_cache $suffix } errmsg]} {
ns_return 200 text/html "Cannot flush the cache for $suffix suffix."
}
}
Index: openacs-4/packages/acs-admin/www/cache/flush.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/cache/flush.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/www/cache/flush.tcl 8 Jan 2004 15:45:04 -0000 1.2
+++ openacs-4/packages/acs-admin/www/cache/flush.tcl 10 Jan 2007 21:22:00 -0000 1.3
@@ -25,7 +25,7 @@
}
}
- if {![info exists value] || [string equal "" $value]} {
+ if {![info exists value] || "" eq $value} {
ad_return_complaint 1 "Could not retrieve"
}
}
Index: openacs-4/packages/acs-admin/www/cache/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/cache/index.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/www/cache/index.tcl 8 Oct 2003 11:03:47 -0000 1.2
+++ openacs-4/packages/acs-admin/www/cache/index.tcl 10 Jan 2007 21:22:00 -0000 1.3
@@ -9,16 +9,16 @@
foreach cache [lsort -dictionary [ns_cache_names]] {
if {[regexp {util_memoize_(.*)} $cache match suffix] \
- || [string equal $cache "util_memoize"]} {
- if {![info exists suffix] || [string equal "" $suffix]} {
+ || $cache eq "util_memoize"} {
+ if {![info exists suffix] || "" eq $suffix} {
set name "util_memoize"
set match "util_memoize"
} else {
set name $suffix
}
set pair [ns_cache_size $match]
- set size [format "%.2f MB" [expr [lindex $pair 1] / 1048576.0]]
- set max [format "%.2f MB" [expr [lindex $pair 0] / 1048576.0]]
+ set size [format "%.2f MB" [expr {[lindex $pair 1] / 1048576.0}]]
+ set max [format "%.2f MB" [expr {[lindex $pair 0] / 1048576.0}]]
ns_cache_stats $match stats_array
set entries $stats_array(entries)
set flushed $stats_array(flushed)
Index: openacs-4/packages/acs-admin/www/cache/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/cache/one.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/www/cache/one.tcl 8 Oct 2003 11:03:47 -0000 1.2
+++ openacs-4/packages/acs-admin/www/cache/one.tcl 10 Jan 2007 21:22:00 -0000 1.3
@@ -25,7 +25,7 @@
}
}
}
- if {![info exists value] || [string equal "" $value]} {
+ if {![info exists value] || "" eq $value} {
set value "<i>could not retrieve</i>"
set time "?"
}
Index: openacs-4/packages/acs-admin/www/install/install-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/install/install-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-admin/www/install/install-2.tcl 4 Oct 2003 03:03:29 -0000 1.1
+++ openacs-4/packages/acs-admin/www/install/install-2.tcl 10 Jan 2007 21:22:00 -0000 1.2
@@ -37,7 +37,7 @@
}
}
-if { ![empty_string_p $repository_url] } {
+if { $repository_url ne "" } {
set parent_page_title "Install From OpenACS Repository"
} else {
set parent_page_title "Install From Local File System"
@@ -63,7 +63,7 @@
multirow create install package_key version_name package_name comment extra_p
foreach key $result(packages) {
- set extra_p [expr [lsearch $package_key $key] == -1]
+ set extra_p [expr {[lsearch $package_key $key] == -1}]
if { $extra_p } {
set extras_p 1
}
Index: openacs-4/packages/acs-admin/www/install/install-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/install/install-3.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-admin/www/install/install-3.tcl 17 May 2004 15:14:41 -0000 1.8
+++ openacs-4/packages/acs-admin/www/install/install-3.tcl 10 Jan 2007 21:22:00 -0000 1.9
@@ -56,7 +56,7 @@
if { [exists_and_not_null version(download_url)] } {
set spec_file [apm_load_apm_file -url $version(download_url)]
- if { [empty_string_p $spec_file] } {
+ if { $spec_file eq "" } {
ns_log Error "Error downloading package $package_key from $version(download_url). Installing package failed."
set success_p 0
continue
Index: openacs-4/packages/acs-admin/www/install/install-4.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/install/install-4.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-admin/www/install/install-4.tcl 4 Jun 2006 00:45:20 -0000 1.3
+++ openacs-4/packages/acs-admin/www/install/install-4.tcl 10 Jan 2007 21:22:00 -0000 1.4
@@ -5,7 +5,7 @@
{success_p 0}
}
-if { ![empty_string_p $repository_url] } {
+if { $repository_url ne "" } {
set parent_page_title "Install From OpenACS Repository"
set parent_page_url [export_vars -base install {repository_url}]
} else {
Index: openacs-4/packages/acs-admin/www/install/install.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/install/install.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-admin/www/install/install.tcl 4 Jun 2006 00:45:20 -0000 1.5
+++ openacs-4/packages/acs-admin/www/install/install.tcl 10 Jan 2007 21:22:00 -0000 1.6
@@ -7,7 +7,7 @@
}
-if { ![empty_string_p $repository_url] } {
+if { $repository_url ne "" } {
set page_title "Install or Upgrade From OpenACS Repository"
} else {
set page_title "Install or Upgrade From Local File System"
@@ -36,7 +36,7 @@
set package_key $version(package.key)
# If in upgrade mode, only add to list if it's an upgrade
- if { !$upgrade_p || [string equal $version(install_type) upgrade] } {
+ if { !$upgrade_p || $version(install_type) eq "upgrade" } {
if {![exists_and_not_null version(maturity)]} {
set version(maturity) ""
}
Index: openacs-4/packages/acs-admin/www/test/security-test.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/test/Attic/security-test.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-admin/www/test/security-test.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-admin/www/test/security-test.tcl 10 Jan 2007 21:22:00 -0000 1.2
@@ -10,7 +10,7 @@
set result [ad_get_client_property test MyName]
-if { [string compare $result MyValue] == 0 } {
+if { $result eq "MyValue" } {
ns_write "<li>Success: Client property successfully retrieved..."
} else {
ns_write "<li>Failure: Client property was incorrectly retrieved, expected MyValue, instead got $result..."
Index: openacs-4/packages/acs-admin/www/test/signed-cookies-test-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/test/Attic/signed-cookies-test-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-admin/www/test/signed-cookies-test-2.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-admin/www/test/signed-cookies-test-2.tcl 10 Jan 2007 21:22:00 -0000 1.2
@@ -98,7 +98,7 @@
where token_id = :token_id
}]
-if { [string compare $token_value $token_value_db] == 0 } {
+if { $token_value eq $token_value_db } {
ns_write "<li>Success: sec_get_token test 1 passed."
} else {
ns_write "<li>Failure: sec_get_token test 1 failed."
@@ -107,7 +107,7 @@
# do the same thing again to test the caching of tcl_
set token_value [sec_get_token $token_id]
-if { [string compare $token_value $token_value_db] == 0 } {
+if { $token_value eq $token_value_db } {
ns_write "<li>Success: sec_get_token test 2
passed."
} else {
Index: openacs-4/packages/acs-admin/www/users/complex-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/users/complex-search.tcl,v
diff -u -r1.10 -r1.11
--- openacs-4/packages/acs-admin/www/users/complex-search.tcl 29 Oct 2003 13:12:14 -0000 1.10
+++ openacs-4/packages/acs-admin/www/users/complex-search.tcl 10 Jan 2007 21:22:00 -0000 1.11
@@ -66,7 +66,7 @@
set context [list [list "index" "Users"] "Complex search"]
-if { ![info exists target] || [empty_string_p $target] } {
+if { ![info exists target] || $target eq "" } {
incr exception_count
append exception_text "<li>Target was not specified. This shouldn't have
happened, please contact the
@@ -80,7 +80,7 @@
}
-if {[string equal $combine_method "any"]} {
+if {$combine_method eq "any"} {
set where_conjunction "or"
} else {
set where_conjunction "and"
@@ -231,7 +231,7 @@
set user_search:[set rowcount](export_vars) [export_url_vars user_id_from_search first_names_from_search last_name_from_search email_from_search]
set user_search:[set rowcount](member_state) $member_state
- if { $member_state != "approved" } {
+ if { $member_state ne "approved" } {
set user_search:[set rowcount](user_finite_state_links) [join [ad_registration_finite_state_machine_admin_links $member_state $email_verified_p $user_id_from_search "complex-search?[export_url_vars email last_name keyword target passthrough limit_users_in_group_id only_authorized_p]"] " | "]
} else {
set user_search:[set rowcount](user_finite_state_links) ""
Index: openacs-4/packages/acs-admin/www/users/member-state-change.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/users/member-state-change.tcl,v
diff -u -r1.11 -r1.12
--- openacs-4/packages/acs-admin/www/users/member-state-change.tcl 1 Mar 2005 00:01:21 -0000 1.11
+++ openacs-4/packages/acs-admin/www/users/member-state-change.tcl 10 Jan 2007 21:22:00 -0000 1.12
@@ -69,7 +69,7 @@
}
}
-if [empty_string_p $action] {
+if {$action eq ""} {
ad_return_complaint 1 "Not valid action: You have not changed the user in any way"
return
}
@@ -97,7 +97,7 @@
set subject "$action"
set message $email_message
-if [empty_string_p $return_url] {
+if {$return_url eq ""} {
set return_url "/acs-admin/users/one?[export_url_vars user_id]"
} else {
ad_returnredirect $return_url
Index: openacs-4/packages/acs-admin/www/users/merge-confirm.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/users/merge-confirm.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/www/users/merge-confirm.tcl 4 Jun 2006 00:45:20 -0000 1.2
+++ openacs-4/packages/acs-admin/www/users/merge-confirm.tcl 10 Jan 2007 21:22:00 -0000 1.3
@@ -14,14 +14,14 @@
if_diff_authority {
set from_authority_id [db_string gettoa "select authority_id from cc_users where user_id = :from_user_id"]
set to_authority_id [db_string getfroma "select authority_id from cc_users where user_id = :to_user_id"]
- if { ![string equal $from_authority_id $to_authority_id] } {
+ if { $from_authority_id ne $to_authority_id } {
ad_complain "Merge only works for users from the same authority"
}
}
}
-if { [string equal $merge_action "0"] } {
+if {$merge_action eq "0"} {
set tempid $from_user_id
set from_user_id $to_user_id
set to_user_id $tempid
Index: openacs-4/packages/acs-admin/www/users/merge-final.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/users/merge-final.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-admin/www/users/merge-final.tcl 15 Dec 2006 00:00:54 -0000 1.3
+++ openacs-4/packages/acs-admin/www/users/merge-final.tcl 10 Jan 2007 21:22:00 -0000 1.4
@@ -14,14 +14,14 @@
if_diff_authority {
set from_authority_id [db_string gettoa "select authority_id from cc_users where user_id = :from_user_id"]
set to_authority_id [db_string getfroma "select authority_id from cc_users where user_id = :to_user_id"]
- if { ![string equal $from_authority_id $to_authority_id] } {
+ if { $from_authority_id ne $to_authority_id } {
ad_complain "Merge only works for users of the same authority"
}
}
if_the_logged_in_user_is_crazy {
# Just for security reasons...
set current_user_id [ad_conn user_id]
- if { [string equal $current_user_id $to_user_id] || [string equal $current_user_id $from_user_id] } {
+ if { $current_user_id eq $to_user_id || $current_user_id eq $from_user_id } {
ad_complain "You can't merge yourself"
}
}
Index: openacs-4/packages/acs-admin/www/users/merge.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/users/merge.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-admin/www/users/merge.tcl 15 Dec 2006 00:00:54 -0000 1.3
+++ openacs-4/packages/acs-admin/www/users/merge.tcl 10 Jan 2007 21:22:00 -0000 1.4
@@ -15,7 +15,7 @@
if_the_logged_in_user_is_crazy {
# Just for security reasons...
set current_user_id [ad_conn user_id]
- if { [string equal $current_user_id $user_id] || [string equal $current_user_id $user_id_from_search] } {
+ if { $current_user_id eq $user_id || $current_user_id eq $user_id_from_search } {
ad_complain "You can't merge yourself"
}
}
@@ -39,7 +39,7 @@
}
set user_id_one_items [callback merge::MergeShowUserInfo -user_id $user_id ]
-if { ![empty_string_p $user_id_one_items] } {
+if { $user_id_one_items ne "" } {
set user_id_one_items_html "<ul><li><b>Packages User Information </b><ul>"
foreach pkg_list $user_id_one_items {
append user_id_one_items_html "<li><i>[lindex $pkg_list 0]</i><ul>"
@@ -70,7 +70,7 @@
}
set user_id_two_items [callback merge::MergeShowUserInfo -user_id $user_id_from_search ]
-if { ![empty_string_p $user_id_two_items] } {
+if { $user_id_two_items ne "" } {
set user_id_two_items_html "<ul><li><b>Packages User Information </b><ul>"
foreach pkg_list $user_id_two_items {
append user_id_two_items_html "<li><i>[lindex $pkg_list 0]</i><ul>"
Index: openacs-4/packages/acs-admin/www/users/modify-admin-privileges.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/users/modify-admin-privileges.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/www/users/modify-admin-privileges.tcl 30 Nov 2002 17:13:22 -0000 1.2
+++ openacs-4/packages/acs-admin/www/users/modify-admin-privileges.tcl 10 Jan 2007 21:22:00 -0000 1.3
@@ -16,12 +16,12 @@
set context [list [list "./" "Users"] "Modify privileges"]
-if ![info exists confirmed_p] {
+if {![info exists confirmed_p]} {
set confirmed_p 0
}
-if $confirmed_p {
- if [string equal grant $action] {
+if {$confirmed_p} {
+ if {"grant" eq $action} {
permission::grant -object_id [acs_magic_object "security_context_root"] -party_id $user_id -privilege "admin"
} else {
permission::revoke -object_id [acs_magic_object "security_context_root"] -party_id $user_id -privilege "admin"
Index: openacs-4/packages/acs-admin/www/users/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/users/one.tcl,v
diff -u -r1.14 -r1.15
--- openacs-4/packages/acs-admin/www/users/one.tcl 13 Jan 2005 13:54:41 -0000 1.14
+++ openacs-4/packages/acs-admin/www/users/one.tcl 10 Jan 2007 21:22:00 -0000 1.15
@@ -105,7 +105,7 @@
# set contact_info [ad_user_contact_info $user_id "site_admin"]
-# if ![empty_string_p $contact_info] {
+# if {$contact_info ne ""} {
# append whole_page "<h3>Contact Info</h3>\n\n$contact_info\n
# <ul>
# <li><a href=contact-edit?[export_url_vars user_id]>Edit contact information</a>
@@ -117,24 +117,24 @@
# </ul>"
# }
-# if [db_table_exists users_demographics] {
-# if [db_0or1row user_demographics "select
+# if {[db_table_exists users_demographics]} {
+# if {[db_0or1row user_demographics "select
# ud.*,
# u.first_names as referring_user_first_names,
# u.last_name as referring_user_last_name
# from users_demographics ud, users u
# where ud.user_id = $user_id
-# and ud.referred_by = u.user_id(+)"] {
+# and ud.referred_by = u.user_id(+)"]} {
# # the table exists and there is a row for this user
# set demographic_items ""
# for {set i 0} {$i<[ns_set size $selection]} {incr i} {
# set varname [ns_set key $selection $i]
# set varvalue [ns_set value $selection $i]
-# if { $varname != "user_id" && ![empty_string_p $varvalue] } {
+# if { $varname ne "user_id" && $varvalue ne "" } {
# append demographic_items "<li>$varname: $varvalue\n"
# }
# }
-# if ![empty_string_p $demographic_items] {
+# if {$demographic_items ne ""} {
# append whole_page "<h3>Demographics</h3>\n\n<ul>$demographic_items</ul>\n"
# }
@@ -150,7 +150,7 @@
# append category_items "<LI>$category\n"
# }
-# if ![empty_string_p $category_items] {
+# if {$category_items ne ""} {
# append whole_page "<H3>Interests</H3>\n\n<ul>\n\n$category_items\n\n</ul>"
# }
# }
Index: openacs-4/packages/acs-admin/www/users/search.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/users/search.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-admin/www/users/search.tcl 4 Jun 2006 00:45:20 -0000 1.5
+++ openacs-4/packages/acs-admin/www/users/search.tcl 10 Jan 2007 21:22:00 -0000 1.6
@@ -45,27 +45,27 @@
set context [list [list "./" "Users"] "Search"]
-if [info exists keyword] {
+if {[info exists keyword]} {
# this is an administrator
- if { [empty_string_p $keyword] } {
+ if { $keyword eq "" } {
incr exception_count
append exception_text "<li>You forgot to type a search string!\n"
}
} else {
# from one of the user pages
- if { (![info exists email] || [empty_string_p $email]) && \
- (![info exists last_name] || [empty_string_p $last_name]) } {
+ if { (![info exists email] || $email eq "") && \
+ (![info exists last_name] || $last_name eq "") } {
incr exception_count
append exception_text "<li>You must specify either an email address or last name to search for.\n"
}
if { [info exists email] && [info exists last_name] && \
- ![empty_string_p $email] && ![empty_string_p $last_name] } {
+ $email ne "" && $last_name ne "" } {
incr exception_count
append exception_text "<li>You can only specify either email or last name, not both.\n"
}
- if { ![info exists target] || [empty_string_p $target] } {
+ if { ![info exists target] || $target eq "" } {
incr exception_count
append exception_text "<li>Target was not specified. This shouldn't have happened,
please contact the <a href=\"mailto:[ad_host_administrator]\">administrator</a>
@@ -86,7 +86,7 @@
set search_type "keyword"
set sql_keyword "%[string tolower $keyword]%"
lappend where_clause "(email like :sql_keyword or lower(first_names || ' ' || last_name) like :sql_keyword)"
-} elseif { [info exists email] && ![empty_string_p $email] } {
+} elseif { [info exists email] && $email ne "" } {
set search_type "email"
set sql_email "%[string tolower $email]%"
lappend where_clause "email like :sql_email"
@@ -141,7 +141,7 @@
set last_name_from_search $last_name
set email_from_search $email
- if { [empty_string_p $from_user_id] } {
+ if { $from_user_id eq "" } {
set user_search:[set rowcount](user_id) $user_id
} else {
set user_search:[set rowcount](user_id) $from_user_id
@@ -153,7 +153,7 @@
set user_search:[set rowcount](export_vars) [export_url_vars user_id_from_search first_names_from_search last_name_from_search email_from_search]
set user_search:[set rowcount](member_state) $member_state
- if { $member_state != "approved" } {
+ if { $member_state ne "approved" } {
set user_search:[set rowcount](user_finite_state_links) [join [ad_registration_finite_state_machine_admin_links $member_state $email_verified_p $user_id_from_search "search?[export_url_vars email last_name keyword target passthrough limit_users_in_group_id only_authorized_p]"] " | "]
} else {
set user_search:[set rowcount](user_finite_state_links) ""
Index: openacs-4/packages/acs-admin/www/users/session-history.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/users/Attic/session-history.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-admin/www/users/session-history.tcl 6 Sep 2002 21:49:53 -0000 1.2
+++ openacs-4/packages/acs-admin/www/users/session-history.tcl 10 Jan 2007 21:22:00 -0000 1.3
@@ -31,7 +31,7 @@
while { [ns_db getrow $db $selection] } {
set_variables_after_query
if { $last_year != $pretty_year } {
- if { ![empty_string_p $last_year] } {
+ if { $last_year ne "" } {
# insert a line break
append whole_page "<tr><td colspan=2> </tr>\n"
}
Index: openacs-4/packages/acs-admin/www/users/user-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/users/user-add-2.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-admin/www/users/user-add-2.tcl 1 Mar 2005 00:01:21 -0000 1.8
+++ openacs-4/packages/acs-admin/www/users/user-add-2.tcl 10 Jan 2007 21:22:00 -0000 1.9
@@ -26,7 +26,7 @@
set $var_name $user($var_name)
}
-if { [empty_string_p $password] } {
+if { $password eq "" } {
set password [ad_generate_random_string]
}
Index: openacs-4/packages/acs-admin/www/users/user-batch-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/users/user-batch-add-2.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-admin/www/users/user-batch-add-2.tcl 15 Mar 2004 11:12:11 -0000 1.4
+++ openacs-4/packages/acs-admin/www/users/user-batch-add-2.tcl 10 Jan 2007 21:22:00 -0000 1.5
@@ -25,7 +25,7 @@
while {[regexp {(.[^\n]+)} $userlist match_fodder row] } {
# remove each row as it's handled
set remove_count [string length $row]
- set userlist [string range $userlist [expr $remove_count + 1] end]
+ set userlist [string range $userlist [expr {$remove_count + 1}] end]
set row [split $row ,]
set email [string trim [lindex $row 0]]
set first_names [string trim [lindex $row 1]]
@@ -44,12 +44,12 @@
}
}
- if {![info exists first_names] || [empty_string_p $first_names]} {
+ if {![info exists first_names] || $first_names eq ""} {
append exception_text "<li> No first name in ($row)</li>\n"
continue
}
- if {![info exists last_name] || [empty_string_p $last_name]} {
+ if {![info exists last_name] || $last_name eq ""} {
append exception_text "<li> No last name in ($row)</li>\n"
continue
}
Index: openacs-4/packages/acs-api-browser/tcl/acs-api-documentation-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-api-browser/tcl/acs-api-documentation-procs.tcl,v
diff -u -r1.21 -r1.22
--- openacs-4/packages/acs-api-browser/tcl/acs-api-documentation-procs.tcl 19 Dec 2006 09:34:10 -0000 1.21
+++ openacs-4/packages/acs-api-browser/tcl/acs-api-documentation-procs.tcl 10 Jan 2007 21:22:01 -0000 1.22
@@ -50,7 +50,7 @@
# Eliminate any comment characters.
regsub -all {#.*$} $line "" line
set line [string trim $line]
- if { ![empty_string_p $line] } {
+ if { $line ne "" } {
set has_contract_p [regexp {^ad_page_contract\s} $line]
break
}
@@ -177,10 +177,10 @@
# If it's not a Tcl file, we can't do a heck of a lot yet. Eventually
# we'll be able to handle ADPs, at least.
- if { [string equal [file extension $path] ".xql"] } {
+ if {[file extension $path] eq ".xql"} {
append out "<blockquote>DB Query file</blockquote>\n"
return $out
- } elseif { ![string equal [file extension $path] ".tcl"] } {
+ } elseif { [file extension $path] ne ".tcl" } {
append out "<blockquote><i>Delivered as [ns_guesstype $path]</i></blockquote>\n"
return $out
}
@@ -236,7 +236,7 @@
# }
# append out "</dd>\n"
# }
-# if { [info exists doc_elements(type)] && ![empty_string_p $doc_elements(type)] } {
+# if { [info exists doc_elements(type)] && $doc_elements(type) ne "" } {
# append out "<dt><b>Returns Type:</b><dd><a href=\"type-view?type=$doc_elements(type)\">$doc_elements(type)</a>\n"
# }
# # XXX: Need to support "Returns Properties:"
@@ -266,7 +266,7 @@
if {[nsv_exists api_proc_doc $see]} {
return "<a href=\"proc-view?proc=[ns_urlencode ${see}]\">$see</a>"
}
- if {[string match /doc/*.html $see]
+ if {[string match "/doc/*.html" $see]
|| [util_url_valid_p $see]} {
return "<a href=\"${see}]\">$see</a>"
}
@@ -287,7 +287,7 @@
@param path the path to the file, relative to the OpenACS path root.
} {
- if { ![string equal $format "text/html"] } {
+ if { $format ne "text/html" } {
return -code error "Only text/html documentation is currently supported"
}
@@ -349,13 +349,13 @@
set info $properties($property)
set type [lindex $info 0]
append out "<b>$property</b>"
- if { ![string equal $type "onevalue"] } {
+ if { $type ne "onevalue" } {
append out " ($type)"
}
if { [info exists property_doc($property)] } {
append out " - $property_doc($property)"
}
- if { [string equal $type "onerow"] } {
+ if {$type eq "onerow"} {
append out "<br>\n"
} else {
set columns [lindex $info 1]
@@ -393,9 +393,9 @@
} {
set public_property_name "api,package,$version_id,public_p"
- if { [empty_string_p $public_p] } {
+ if { $public_p eq "" } {
set public_p [ad_get_client_property acs-api-browser $public_property_name]
- if { [empty_string_p $public_p] } {
+ if { $public_p eq "" } {
set public_p 1
}
} else {
@@ -441,8 +441,8 @@
@return the formatted documentation string.
@error if the procedure is not defined.
} {
- if { ![string equal $format "text/html"] && \
- ![string equal $format "text/plain"] } {
+ if { $format ne "text/html" && \
+ $format ne "text/plain" } {
return -code error "Only text/html and text/plain documentation are currently supported"
}
array set doc_elements [nsv_get api_proc_doc $proc_name]
@@ -471,7 +471,7 @@
if {[regexp {^(.+) (.+)$} $cl match scope cl]} {
set cl "$scope do $cl"
}
- if {[string equal "" $prefix]} {
+ if {$prefix eq ""} {
set pretty_proc_name "[::xotcl::api object_link $scope $cl] $method"
} else {
set pretty_proc_name \
@@ -557,7 +557,7 @@
}
if { [info exists default_values($switch)] && \
- ![empty_string_p $default_values($switch)] } {
+ $default_values($switch) ne "" } {
append out " (defaults to <code>\"$default_values($switch)\"</code>)"
}
@@ -579,7 +579,7 @@
foreach positional $doc_elements(positionals) {
append out "<b>$positional</b>"
if { [info exists default_values($positional)] } {
- if { [empty_string_p $default_values($positional)] } {
+ if { $default_values($positional) eq "" } {
append out " (optional)"
} else {
append out " (defaults to <code>\"$default_values($positional)\"</code>)"
@@ -717,7 +717,7 @@
basically a -1,0,1 result comparing the second element of the
list inputs then the first (both strings)
} {
- if {[string equal [lindex $l1 1] [lindex $l2 1]]} {
+ if {[lindex $l1 1] eq [lindex $l2 1]} {
return [string compare [lindex $l1 0] [lindex $l2 0]]
} else {
return [string compare [lindex $l1 1] [lindex $l2 1]]
@@ -728,7 +728,7 @@
basically a -1,0,1 result comparing the second element of the
list inputs then the first. (both strings)
} {
- if {[string equal [lindex $l1 0] [lindex $l2 0]]} {
+ if {[lindex $l1 0] eq [lindex $l2 0]} {
return [string compare [lindex $l1 1] [lindex $l2 1]]
} else {
return [string compare [lindex $l1 0] [lindex $l2 0]]
@@ -746,7 +746,7 @@
set score 0
foreach word $keywords {
# turns out that "" is never found in a search, so we
- # don't really have to special case $word == ""
+ # don't really have to special case $word eq ""
if {[string match -nocase "*$word*" $string_to_search]} {
incr score
}
@@ -760,7 +760,7 @@
} {
set matches [list]
foreach function [nsv_array names api_proc_doc] {
- if [string match -nocase *$string* $function] {
+ if {[string match -nocase *$string* $function]} {
array set doc_elements [nsv_get api_proc_doc $function]
lappend matches [list "$function" "$doc_elements(positionals)"]
}
@@ -807,7 +807,7 @@
@return boolean value
} {
set result 0
- if {[string match ::* $proc_name]} { ;# only check for absolute names
+ if {[string match "::*" $proc_name]} { ;# only check for absolute names
catch {set result [::xotcl::api inscope $scope ::xotcl::Object isobject $proc_name]}
}
return $result
@@ -877,39 +877,39 @@
# Returns length of subexpression, from open to close quote inclusive
proc length_string {data} {
regexp -indices {[^\\]\"} $data match
- return [expr [lindex $match 1]+1]
+ return [expr {[lindex $match 1]+1}]
}
# Returns length of subexpression, from open to close brace inclusive
# Doesn't deal with unescaped braces in substrings
proc length_braces {data} {
set i 1
for {set count 1} {1} {incr i} {
- if {[string index $data $i] == "\\"} {
+ if {[string index $data $i] eq "\\"} {
incr i
- } elseif {[string index $data $i] == "\{"} {
+ } elseif {[string index $data $i] eq "\{"} {
incr count
- } elseif {[string index $data $i] == "\}"} {
+ } elseif {[string index $data $i] eq "\}"} {
incr count -1
}
if {!$count} { break }
}
- return [expr $i+1]
+ return [expr {$i+1}]
}
# Returns number of spaces until next subexpression
proc length_spaces {data} {
regexp -indices {\s+} $data match
- return [expr [lindex $match 1]+1]
+ return [expr {[lindex $match 1]+1}]
}
# Returns length of a generic subexpression
proc length_exp {data} {
- if {[string index $data 0] == "\""} {
+ if {[string index $data 0] eq "\""} {
return [length_string $data]
- } elseif {[string index $data 0] == "\{"} {
+ } elseif {[string index $data 0] eq "\{"} {
return [length_braces $data]
- } elseif {[string index $data 0] == " "} {
+ } elseif {[string index $data 0] eq " "} {
return [length_spaces $data]
}
if { [regexp -indices { } $data match] } {
@@ -924,17 +924,17 @@
set found_regexp 0
set curchar [string index $data $i]
while {$curchar != "\$" && $curchar != "\[" &&
- ($curchar != "\{" || !$found_regexp)} {
- if {$curchar == "\{"} {set found_regexp 1}
- if {[string match "-start" [string range $data $i [expr $i+5]]]} {
+ ($curchar ne "\{" || !$found_regexp)} {
+ if {$curchar eq "\{"} {set found_regexp 1}
+ if {[string match "-start" [string range $data $i [expr {$i+5}]]]} {
incr i [length_exp [string range $data $i end]] ;# -start
incr i [length_exp [string range $data $i end]] ;# spaces
incr i [length_exp [string range $data $i end]] ;# expression - it could be a var
}
incr i [length_exp [string range $data $i end]]
set curchar [string index $data $i]
}
- return [expr $i -1]
+ return [expr {$i -1}]
}
array set HTML {
@@ -967,7 +967,7 @@
{gets puts socket tell format scan} \
]
- if {[string compare "" [info command ::xotcl::api]]} {
+ if {"" ne [info command ::xotcl::api] } {
set XOTCL_KEYWORDS [list self my next]
# only command names are highlighted, otherwise we could add xotcl method
# names by [lsort -unique [concat [list self my next] ..
@@ -1016,11 +1016,11 @@
}
"\$" {
- if {$in_comment || ([string index $data [expr $i + 1]] == " ")} {
+ if {$in_comment || ([string index $data [expr {$i + 1}]] == " ")} {
append html "\$"
} else {
set varl [length_var [string range $data $i end]]
- append html "$HTML(var)[string range $data $i [expr $i + $varl]]$HTML(/var)"
+ append html "$HTML(var)[string range $data $i [expr {$i + $varl}]]$HTML(/var)"
incr i $varl
}
}
@@ -1039,7 +1039,7 @@
}
"\#" {
- set prevchar [string index $data [expr $i-1]]
+ set prevchar [string index $data [expr {$i-1}]]
if {$proc_ok && !$in_comment && [regexp {[\s;]} $prevchar]} {
set in_comment 1
set proc_ok 0
@@ -1095,7 +1095,7 @@
if {$proc_ok} {
set proc_ok 0
set procl [length_proc [string range $data $i end]]
- set proc_name [string range $data $i [expr $i + $procl]]
+ set proc_name [string range $data $i [expr {$i + $procl}]]
if {[lsearch -exact $KEYWORDS $proc_name] != -1 ||
([regexp {^::(.*)} $proc_name match had_colons] &&
@@ -1130,9 +1130,9 @@
incr i $procl
# Hack for nasty regexp stuff
- if {[string match "regexp" $proc_name] || [string match "regsub" $proc_name]} {
+ if {"regexp" eq $proc_name || "regsub" eq $proc_name} {
set regexpl [length_regexp [string range $data $i end]]
- append html [string range $data [expr $i+1] [expr $i + $regexpl]]
+ append html [string range $data [expr {$i+1}] [expr {$i + $regexpl}]]
incr i $regexpl
}
} else {
Index: openacs-4/packages/acs-api-browser/www/display-sql.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-api-browser/www/display-sql.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-api-browser/www/display-sql.tcl 6 Sep 2002 21:49:54 -0000 1.3
+++ openacs-4/packages/acs-api-browser/www/display-sql.tcl 10 Jan 2007 21:22:01 -0000 1.4
@@ -29,7 +29,7 @@
}
set context [list]
-if [exists_and_not_null version_id] {
+if {[exists_and_not_null version_id]} {
db_0or1row package_info_from_package_id {
select pretty_name, package_key, version_name
from apm_package_version_info
Index: openacs-4/packages/acs-api-browser/www/proc-browse.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-api-browser/www/proc-browse.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-api-browser/www/proc-browse.tcl 10 Sep 2002 22:22:04 -0000 1.3
+++ openacs-4/packages/acs-api-browser/www/proc-browse.tcl 10 Jan 2007 21:22:01 -0000 1.4
@@ -38,18 +38,18 @@
foreach proc [nsv_array names api_proc_doc] {
array set doc_elements [nsv_get api_proc_doc $proc]
- if { $type == "All"} {
+ if { $type eq "All"} {
lappend matches [list $proc $doc_elements(script)]
- } elseif {$type == "Deprecated" && $doc_elements(deprecated_p)} {
+ } elseif {$type eq "Deprecated" && $doc_elements(deprecated_p)} {
lappend matches [list $proc $doc_elements(script)]
- } elseif {$type == "Private" && $doc_elements(private_p) } {
+ } elseif {$type eq "Private" && $doc_elements(private_p) } {
lappend matches [list $proc $doc_elements(script)]
- } elseif {$type == "Public" && $doc_elements(public_p) } {
+ } elseif {$type eq "Public" && $doc_elements(public_p) } {
lappend matches [list $proc $doc_elements(script)]
}
}
-if { [string equal $sort_by "file"] } {
+if {$sort_by eq "file"} {
set matches [lsort -command ad_sort_by_second_string_proc $matches]
} else {
set matches [lsort -command ad_sort_by_first_string_proc $matches]
Index: openacs-4/packages/acs-api-browser/www/proc-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-api-browser/www/proc-search.tcl,v
diff -u -r1.11 -r1.12
--- openacs-4/packages/acs-api-browser/www/proc-search.tcl 15 Sep 2003 11:34:08 -0000 1.11
+++ openacs-4/packages/acs-api-browser/www/proc-search.tcl 10 Jan 2007 21:22:01 -0000 1.12
@@ -51,7 +51,7 @@
}
# Exact name search
-if { [string equal $name_weight "exact"] } {
+if {$name_weight eq "exact"} {
set name_weight 5
set exact_match_p 1
} else {
@@ -80,17 +80,17 @@
##Exact match:
if {[string tolower $query_string] == [string tolower $proc]} {
- incr score [expr $name_weight * 2]
+ incr score [expr {$name_weight * 2}]
} elseif { ! $exact_match_p } {
- incr score [expr $name_weight * [ad_keywords_score $query_string $proc]]
+ incr score [expr {$name_weight * [ad_keywords_score $query_string $proc]}]
}
}
################
## Param Search:
################
if {$param_weight} {
- incr score [expr $param_weight * [ad_keywords_score $query_string "$doc_elements(positionals) $doc_elements(switches)"]]
+ incr score [expr {$param_weight * [ad_keywords_score $query_string "$doc_elements(positionals) $doc_elements(switches)"]}]
}
@@ -100,15 +100,15 @@
if {$doc_weight} {
set doc_string "[lindex $doc_elements(main) 0]"
- if [info exists doc_elements(param)] {
+ if {[info exists doc_elements(param)]} {
foreach parameter $doc_elements(param) {
append doc_string " $parameter"
}
}
- if [info exists doc_elements(return)] {
+ if {[info exists doc_elements(return)]} {
append doc_string " $doc_elements(return)"
}
- incr score [expr $doc_weight * [ad_keywords_score $query_string $doc_string]]
+ incr score [expr {$doc_weight * [ad_keywords_score $query_string $doc_string]}]
}
@@ -117,7 +117,7 @@
#################
if {$source_weight} {
if {![catch {set source [info body $proc]}]} {
- incr score [expr $source_weight * [ad_keywords_score $query_string $source]]
+ incr score [expr {$source_weight * [ad_keywords_score $query_string $source]}]
}
}
@@ -143,7 +143,7 @@
set matches [lsort -command ad_sort_by_score_proc $matches]
-if {$quick_view && ![empty_string_p $matches] || [llength $matches] == 1 } {
+if {$quick_view && $matches ne "" || [llength $matches] == 1 } {
ad_returnredirect [api_proc_url [lindex [lindex $matches 0] 0]]
ad_script_abort
}
Index: openacs-4/packages/acs-api-browser/www/procs-file-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-api-browser/www/procs-file-view.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-api-browser/www/procs-file-view.tcl 6 Sep 2002 21:49:54 -0000 1.2
+++ openacs-4/packages/acs-api-browser/www/procs-file-view.tcl 10 Jan 2007 21:22:01 -0000 1.3
@@ -24,7 +24,7 @@
}
}
-if [info exists version_id] {
+if {[info exists version_id]} {
set public_p [api_set_public $version_id $public_p]
} else {
set public_p [api_set_public "" $public_p]
Index: openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl,v
diff -u -r1.74 -r1.75
--- openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 4 Jun 2006 00:45:21 -0000 1.74
+++ openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 10 Jan 2007 21:22:01 -0000 1.75
@@ -43,7 +43,7 @@
}
set message {}
- if { [string equal [ad_conn auth_level] "expired"] } {
+ if {[ad_conn auth_level] eq "expired"} {
set message [_ acs-subsite.lt_Your_login_has_expire]
}
@@ -63,7 +63,7 @@
@see ad_script_abort
} {
- if { ![string equal [ad_conn auth_level] "expired"] } {
+ if { [ad_conn auth_level] ne "expired" } {
return [ad_conn user_id]
}
@@ -104,7 +104,7 @@
}
# Check account status
- if { [string equal $account_status "ok"] && ![string equal [ad_conn account_status] "ok"] } {
+ if { $account_status eq "ok" && [ad_conn account_status] ne "ok" } {
return 0
}
@@ -176,8 +176,8 @@
</ul>
} {
- if { [empty_string_p $username] } {
- if { [empty_string_p $email] } {
+ if { $username eq "" } {
+ if { $email eq "" } {
set result(auth_status) "auth_error"
if { [auth::UseEmailForLoginP] } {
set result(auth_message) [_ acs-subsite.Email_required]
@@ -187,7 +187,7 @@
return [array get result]
}
set user_id [cc_lookup_email_user $email]
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
set result(auth_status) "no_account"
set result(auth_message) [_ acs-subsite.Unknown_email]
return [array get result]
@@ -197,7 +197,7 @@
set username $user(username)
} else {
# Default to local authority
- if { [empty_string_p $authority_id] } {
+ if { $authority_id eq "" } {
set authority_id [auth::authority::local]
}
}
@@ -210,7 +210,7 @@
# We do this so that if there aren't even the auth_status and account_status that need be
# in the array, that gets caught below
- if { [string equal $result(auth_status) "ok"] } {
+ if {$result(auth_status) eq "ok"} {
set dummy $result(account_status)
}
} {
@@ -319,7 +319,7 @@
}
# If the remote account was closed, the whole account is closed, regardless of local account status
- if { [string equal $remote_account_status "closed"] } {
+ if {$remote_account_status eq "closed"} {
set result(account_status) closed
}
@@ -333,7 +333,7 @@
}
# Issue login cookie if login was successful
- if { [string equal $result(auth_status) "ok"] && !$no_cookie_p && [exists_and_not_null result(user_id)] } {
+ if { $result(auth_status) eq "ok" && !$no_cookie_p && [exists_and_not_null result(user_id)] } {
auth::issue_login \
-user_id $result(user_id) \
-persistent=$persistent_p \
@@ -371,7 +371,7 @@
# Check that the authority has a register implementation
auth::authority::get -authority_id $authority_id -array authority
- if { [empty_string_p $authority(register_impl_id)] } {
+ if { $authority(register_impl_id) eq "" } {
ns_log Error "auth::get_register_authority: parameter value for RegisterAuthority is an authority without registration driver, defaulting to local authority"
set authority_id [auth::authority::local]
}
@@ -441,7 +441,7 @@
#####
if { $verify_password_confirm_p } {
- if { ![string equal $password $password_confirm] } {
+ if { $password ne $password_confirm } {
return [list \
creation_status data_error \
creation_message [_ acs-subsite.Passwords_dont_match] \
@@ -481,7 +481,7 @@
# so we control it 100%
# Local account creation ok?
- if { [string equal $creation_info(creation_status) "ok"] } {
+ if {$creation_info(creation_status) eq "ok"} {
# Need to find out which username was set
set username $creation_info(username)
@@ -578,7 +578,7 @@
ns_log Error "auth::create_user: Error invoking account registration driver for authority_id = $authority_id: $errorInfo"
}
- if { ![string equal $creation_info(creation_status) "ok"] } {
+ if { $creation_info(creation_status) ne "ok" } {
return [array get creation_info]
}
@@ -589,7 +589,7 @@
#####
# If the local account was closed, the whole account is closed, regardless of remote account status
- if { [string equal $local_account_status "closed"] } {
+ if {$local_account_status eq "closed"} {
set creation_info(account_status) closed
}
@@ -603,7 +603,7 @@
}
# Issue login cookie if login was successful
- if { !$nologin_p && [string equal $creation_info(creation_status) "ok"] && [string equal $creation_info(account_status) "ok"] && [ad_conn user_id] == 0 } {
+ if { !$nologin_p && $creation_info(creation_status) eq "ok" && $creation_info(account_status) eq "ok" && [ad_conn user_id] == 0 } {
auth::issue_login -user_id $creation_info(user_id)
}
@@ -872,7 +872,7 @@
# Default a local account username
if { $user_info(authority_id) == [auth::authority::local] \
&& [auth::UseEmailForLoginP] \
- && [empty_string_p $username] } {
+ && $username eq "" } {
# Generate a username that's guaranteed to be unique
# Rather much work, but that's the best I could think of
@@ -884,7 +884,7 @@
set existing_user_id [acs_user::get_by_username -authority_id $authority_id -username $username]
# If so, add -2 or -3 or ... to make it unique
- if { ![empty_string_p $existing_user_id] } {
+ if { $existing_user_id ne "" } {
set match "${username}-%"
set existing_usernames [db_list select_existing_usernames {
select username
@@ -897,7 +897,7 @@
foreach existing_username $existing_usernames {
if { [regexp "^${username}-(\\d+)\$" $existing_username match existing_number] } {
# matches the foo-123 pattern
- if { $existing_number >= $number } { set number [expr $existing_number + 1] }
+ if { $existing_number >= $number } { set number [expr {$existing_number + 1}] }
}
}
set username "$username-$number"
@@ -944,7 +944,7 @@
set result(user_id) $user_id
- if { [empty_string_p $username] } {
+ if { $username eq "" } {
set username [acs_user::get_element -user_id $user_id -element username]
}
set result(username) $username
@@ -1130,7 +1130,7 @@
-authority_id $authority_id \
-username $username]
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
set result(delete_status) "delete_error"
set result(delete_message) [_ acs-subsite.No_user_with_this_username]
return [array get result]
@@ -1192,7 +1192,7 @@
# auth_info(account_message)
# auth_info(user_id)
- if { [empty_string_p $authority_id] } {
+ if { $authority_id eq "" } {
set authority_id [auth::authority::local]
}
@@ -1210,15 +1210,15 @@
-authority_id $authority_id \
-username $username]
- if { [string equal $info_result(info_status) "ok"] } {
+ if {$info_result(info_status) eq "ok"} {
array set user $info_result(user_info)
array set creation_info [auth::create_local_account \
-authority_id $authority_id \
-username $username \
-array user]
- if { [string equal $creation_info(creation_status) "ok"] } {
+ if {$creation_info(creation_status) eq "ok"} {
acs_user::get -authority_id $authority_id -username $username -array user
} else {
set auth_info(account_status) "closed"
@@ -1228,7 +1228,7 @@
set auth_info(account_message) "You have successfully authenticated, but we were unable to create an account for you on $system_name. "
append auth_info(account_message) "The error was: $creation_info(element_messages). Please contact the system administrator."
- if { ![empty_string_p $authority(help_contact_text)] } {
+ if { $authority(help_contact_text) ne "" } {
append auth_info(account_message) "<p><h3>Help Information</h3>"
append auth_info(account_message) [ad_html_text_convert \
-from $authority(help_contact_text_format) \
@@ -1247,7 +1247,7 @@
set system_name [ad_system_name]
set auth_info(account_message) [_ acs-subsite.Success_but_no_account_yet]
- if { ![empty_string_p $authority(help_contact_text)] } {
+ if { $authority(help_contact_text) ne "" } {
append auth_info(account_message) [_ acs-subsite.Help_information]
append auth_info(account_message) [ad_html_text_convert \
-from $authority(help_contact_text_format) \
@@ -1303,7 +1303,7 @@
set PasswordExpirationDays [parameter::get -parameter PasswordExpirationDays -package_id [ad_acs_kernel_id] -default 0]
- if { $email_verified_p == "f" } {
+ if { $email_verified_p eq "f" } {
if { !$no_dialogue_p } {
set result(account_message) "<p>[_ acs-subsite.lt_Registration_informat]</p><p>[_ acs-subsite.lt_Please_read_and_follo]</p>"
@@ -1315,11 +1315,11 @@
set result(account_message) [_ acs-subsite.Error_sending_verification_mail]
}
}
- } elseif { [string equal [acs_user::ScreenName] "require"] && [empty_string_p $screen_name] } {
+ } elseif { [string equal [acs_user::ScreenName] "require"] && $screen_name eq "" } {
set message "Please enter a screen name now."
set result(account_url) [export_vars -no_empty -base "[subsite::get_element -element url]user/basic-info-update" { message return_url {edit_p 1} }]
} elseif { $PasswordExpirationDays > 0 && \
- ([empty_string_p $password_age_days] || $password_age_days > $PasswordExpirationDays) } {
+ ($password_age_days eq "" || $password_age_days > $PasswordExpirationDays) } {
set message [_ acs-subsite.Password_regular_change_now]
set result(account_url) [export_vars -base "[subsite::get_element -element url]user/password-update" { return_url message }]
@@ -1434,7 +1434,7 @@
-authority_id $authority_id \
-username $username]
- if { [empty_string_p $user(user_id)] } {
+ if { $user(user_id) eq "" } {
set this_authority [auth::authority::get_element -authority_id $authority_id -element pretty_name]
set element_messages(username) [_ acs-subsite.Username_not_found_for_authority]
}
@@ -1461,7 +1461,7 @@
}
if { [info exists user(url)] } {
- if { [empty_string_p $user(url)] || [string equal $user(url) "http://"] } {
+ if { $user(url) eq "" || $user(url) eq "http://" } {
# The user left the default hint for the url
set user(url) {}
} elseif { ![util_url_valid_p $user(url)] } {
@@ -1472,7 +1472,7 @@
if { [info exists user(screen_name)] } {
set screen_name_user_id [acs_user::get_user_id_by_screen_name -screen_name $user(screen_name)]
- if { ![empty_string_p $screen_name_user_id] && (!$update_p || $screen_name_user_id != $user(user_id)) } {
+ if { $screen_name_user_id ne "" && (!$update_p || $screen_name_user_id != $user(user_id)) } {
set element_messages(screen_name) [_ acs-subsite.screen_name_already_taken]
# We could do the same logic as below with 'stealing' the screen_name of an old, banned user.
@@ -1484,11 +1484,11 @@
set email $user(email)
set email_party_id [party::get_by_email -email $user(email)]
- if { ![empty_string_p $email_party_id] && (!$update_p || $email_party_id != $user(user_id)) } {
+ if { $email_party_id ne "" && (!$update_p || $email_party_id != $user(user_id)) } {
# We found a user with this email, and either we're not updating,
# or it's not the same user_id as the one we're updating
- if { ![string equal [acs_object_type $email_party_id] "user"] } {
+ if { [acs_object_type $email_party_id] ne "user" } {
set element_messages(email) [_ acs-subsite.Have_group_mail]
} else {
acs_user::get \
@@ -1516,7 +1516,7 @@
# Check that username is unique
set username_user_id [acs_user::get_by_username -authority_id $authority_id -username $user(username)]
- if { ![empty_string_p $username_user_id] && (!$update_p || $username_user_id != $user(user_id)) } {
+ if { $username_user_id ne "" && (!$update_p || $username_user_id != $user(user_id)) } {
# We already have a user with this username, and either we're not updating, or it's not the same user_id as the one we're updating
set username_member_state [acs_user::get_element -user_id $username_user_id -element member_state]
@@ -1581,7 +1581,7 @@
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "auth_impl_id"]
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
# No implementation of authentication
set authority_pretty_name [auth::authority::get_element -authority_id $authority_id -element "pretty_name"]
error "The authority '$authority_pretty_name' doesn't support authentication"
@@ -1638,7 +1638,7 @@
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "register_impl_id"]
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
# No implementation of authentication
set authority_pretty_name [auth::authority::get_element -authority_id $authority_id -element "pretty_name"]
error "The authority '$authority_pretty_name' doesn't support account registration"
@@ -1672,7 +1672,7 @@
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "register_impl_id"]
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
# No implementation of authentication
set authority_pretty_name [auth::authority::get_element -authority_id $authority_id -element "pretty_name"]
error "The authority '$authority_pretty_name' doesn't support account registration"
@@ -1707,7 +1707,7 @@
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "user_info_impl_id"]
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
# No implementation of authentication
return {
info_status no_account
Index: openacs-4/packages/acs-authentication/tcl/authority-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/authority-procs.tcl,v
diff -u -r1.25 -r1.26
--- openacs-4/packages/acs-authentication/tcl/authority-procs.tcl 1 Jul 2004 13:04:55 -0000 1.25
+++ openacs-4/packages/acs-authentication/tcl/authority-procs.tcl 10 Jan 2007 21:22:01 -0000 1.26
@@ -72,7 +72,7 @@
db_transaction {
- if { [empty_string_p $authority_id] } {
+ if { $authority_id eq "" } {
set authority_id [db_nextval "acs_object_id_seq"]
}
@@ -119,7 +119,7 @@
# Auto generate short name if not provided and make
# sure it's unique
# TODO: check for max length 255?
- if { [empty_string_p $short_name] } {
+ if { $short_name eq "" } {
set existing_short_names [db_list select_short_names {
select short_name
from auth_authorities
@@ -251,7 +251,7 @@
if { [lsearch -exact $columns $name] == -1 } {
error "Attribute '$name' isn't valid for auth_authorities."
}
- if { [string equal $name "authority_id"] } {
+ if {$name eq "authority_id"} {
error "Attribute '$name' is the primary key for auth_authorities, and thus cannot be edited."
}
set $name $row($name)
@@ -268,7 +268,7 @@
# check if we need to update the object title
set new_short_name [get_element -authority_id $authority_id -element short_name]
- if {![string equal $old_short_name $new_short_name]} {
+ if {$old_short_name ne $new_short_name } {
db_dml update_object_title {}
}
}
@@ -310,9 +310,9 @@
set message {}
# Verify that we have implementations
- if { [empty_string_p $authority(get_doc_impl_id)] } {
+ if { $authority(get_doc_impl_id) eq "" } {
set message "No Get Document implementation"
- } elseif { [empty_string_p $authority(process_doc_impl_id)] } {
+ } elseif { $authority(process_doc_impl_id) eq "" } {
set message "No Process Document implementation"
} else {
auth::sync::job::start_get_document -job_id $job_id
@@ -341,7 +341,7 @@
-document $doc_result(document) \
-snapshot=$snapshot_p
- if { [string equal $doc_result(doc_status) "ok"] && ![empty_string_p $doc_result(document)] } {
+ if { $doc_result(doc_status) eq "ok" && $doc_result(document) ne "" } {
with_catch errmsg {
auth::sync::ProcessDocument \
-authority_id $authority_id \
@@ -358,7 +358,7 @@
-package_key acs-authentication \
-default {}]
- if { ![empty_string_p $ack_file_name] } {
+ if { $ack_file_name ne "" } {
# Interpolate
set pairs [list \
acs_root_dir [acs_root_dir] \
@@ -378,7 +378,7 @@
set message "Error processing sync document: $errmsg"
}
} else {
- if { [empty_string_p $message] } {
+ if { $message eq "" } {
set message $doc_result(doc_message)
}
}
@@ -492,7 +492,7 @@
@see auth::authority::get
} {
- if { ![empty_string_p $authority_id] } {
+ if { $authority_id ne "" } {
util_memoize_flush [list auth::authority::get_not_cached $authority_id]
} else {
util_memoize_flush_regexp [list auth::authority::get_not_cached .*]
@@ -529,7 +529,7 @@
} {
Flush the cache for gett authority_id by short_name.
} {
- if { [empty_string_p $short_name] } {
+ if { $short_name eq "" } {
util_memoize_flush_regexp [list auth::authority::get_id_not_cached .*]
} else {
util_memoize_flush [list auth::authority::get_id_not_cached -short_name $short_name]
Index: openacs-4/packages/acs-authentication/tcl/driver-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/driver-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-authentication/tcl/driver-procs.tcl 2 Oct 2003 14:22:14 -0000 1.6
+++ openacs-4/packages/acs-authentication/tcl/driver-procs.tcl 10 Jan 2007 21:22:01 -0000 1.7
@@ -25,7 +25,7 @@
@author Simon Carstensen (simon@collaboraid.biz)
@creation-date 2003-08-27
} {
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
return {}
}
Index: openacs-4/packages/acs-authentication/tcl/local-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/local-procs.tcl,v
diff -u -r1.31 -r1.32
--- openacs-4/packages/acs-authentication/tcl/local-procs.tcl 19 Oct 2006 12:54:57 -0000 1.31
+++ openacs-4/packages/acs-authentication/tcl/local-procs.tcl 10 Jan 2007 21:22:01 -0000 1.32
@@ -144,12 +144,12 @@
} {
array set auth_info [list]
- if [empty_string_p $authority_id] {
+ if {$authority_id eq ""} {
set authority_id [auth::authority::local]
}
set user_id [acs_user::get_by_username -authority_id $authority_id -username $username]
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
set result(auth_status) "no_account"
return [array get result]
}
@@ -263,12 +263,12 @@
}
set user_id [acs_user::get_by_username -authority_id $authority_id -username $username]
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
set result(password_status) "no_account"
return [array get result]
}
- if { ![empty_string_p $old_password] } {
+ if { $old_password ne "" } {
if { ![ad_check_password $user_id $old_password] } {
set result(password_status) "old_password_bad"
return [array get result]
@@ -357,13 +357,13 @@
}
set user_id [acs_user::get_by_username -authority_id $authority_id -username $username]
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
set result(password_status) "no_account"
return [array get result]
}
# Reset the password
- if [exists_and_not_null new_password] {
+ if {[exists_and_not_null new_password]} {
set password $new_password
} else {
set password [ad_generate_random_string]
@@ -480,7 +480,7 @@
# LARS TODO: Move this out of the local driver and into the auth framework
# Generate random password?
set generated_pwd_p 0
- if { [empty_string_p $password] || [parameter::get -package_id [ad_conn subsite_id] -parameter RegistrationProvidesRandomPasswordP -default 0] } {
+ if { $password eq "" || [parameter::get -package_id [ad_conn subsite_id] -parameter RegistrationProvidesRandomPasswordP -default 0] } {
set password [ad_generate_random_string]
set generated_pwd_p 1
}
Index: openacs-4/packages/acs-authentication/tcl/password-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/password-procs.tcl,v
diff -u -r1.14 -r1.15
--- openacs-4/packages/acs-authentication/tcl/password-procs.tcl 27 Sep 2006 10:43:51 -0000 1.14
+++ openacs-4/packages/acs-authentication/tcl/password-procs.tcl 10 Jan 2007 21:22:01 -0000 1.15
@@ -41,7 +41,7 @@
regsub -all "{username}" $change_pwd_url $username change_pwd_url
# Default to the OpenACS change password URL
- if { [empty_string_p $change_pwd_url] } {
+ if { $change_pwd_url eq "" } {
set change_pwd_url [export_vars -base "[subsite::get_element -element url]user/password-update" { user_id }]
}
@@ -170,8 +170,8 @@
<li> password_message: Human-readable message to be relayed to the user. May contain HTML.
</ul>
} {
- if { [empty_string_p $username] } {
- if { [empty_string_p $email] } {
+ if { $username eq "" } {
+ if { $email eq "" } {
set result(password_status) "failed_to_connect"
if { [auth::UseEmailForLoginP] } {
set result(password_message) "Email required"
@@ -181,7 +181,7 @@
return [array get result]
}
set user_id [cc_lookup_email_user $email]
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
set result(password_status) "failed_to_connect"
set result(password_message) "Unknown email"
return [array get result]
@@ -191,7 +191,7 @@
set username $user(username)
} else {
# Default to local authority
- if { [empty_string_p $authority_id] } {
+ if { $authority_id eq "" } {
set authority_id [auth::authority::local]
}
}
@@ -201,7 +201,7 @@
-authority_id $authority_id \
-username $username]
- if { ![empty_string_p $forgotten_url] } {
+ if { $forgotten_url ne "" } {
ad_returnredirect $forgotten_url
ad_script_abort
}
@@ -238,33 +238,33 @@
@return A URL that can be linked to when the user has forgotten his/her password,
or the empty string if none can be found.
} {
- if { ![empty_string_p $username] } {
+ if { $username ne "" } {
set local_url [export_vars -no_empty -base "[subsite::get_element -element url]register/recover-password" { authority_id username }]
} else {
set local_url [export_vars -no_empty -base "[subsite::get_element -element url]register/recover-password" { email }]
}
set forgotten_pwd_url {}
- if { ![empty_string_p $username] } {
- if { [empty_string_p $authority_id] } {
+ if { $username ne "" } {
+ if { $authority_id eq "" } {
set authority_id [auth::authority::local]
}
} else {
set user_id [cc_lookup_email_user $email]
- if { ![empty_string_p $user_id] } {
+ if { $user_id ne "" } {
acs_user::get -user_id $user_id -array user
set authority_id $user(authority_id)
set username $user(username)
}
}
- if { ![empty_string_p $username] } {
+ if { $username ne "" } {
# We have the username or email
set forgotten_pwd_url [auth::authority::get_element -authority_id $authority_id -element forgotten_pwd_url]
- if { ![empty_string_p $forgotten_pwd_url] } {
+ if { $forgotten_pwd_url ne "" } {
regsub -all "{username}" $forgotten_pwd_url $username forgotten_pwd_url
} elseif { !$remote_only_p } {
if { [auth::password::can_retrieve_p -authority_id $authority_id] || [auth::password::can_reset_p -authority_id $authority_id] } {
@@ -554,8 +554,8 @@
} else {
set length [string length $account_id_label]
}
- set account_id_label [string range "$account_id_label[string repeat " " $length]" 0 [expr $length-1]]
- set password_label [string range "$password_label[string repeat " " $length]" 0 [expr $length-1]]
+ set account_id_label [string range "$account_id_label[string repeat " " $length]" 0 [expr {$length-1}]]
+ set password_label [string range "$password_label[string repeat " " $length]" 0 [expr {$length-1}]]
set first_names $user(first_names)
set last_name $user(last_name)
@@ -572,7 +572,7 @@
set subject [_ $subject_msg_key]
set body [_ $body_msg_key]
- if { [empty_string_p $from] } {
+ if { $from eq "" } {
set from [ad_system_owner]
}
@@ -592,7 +592,7 @@
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "pwd_impl_id"]
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
return 0
}
@@ -620,7 +620,7 @@
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "pwd_impl_id"]
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
return 0
}
@@ -648,7 +648,7 @@
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "pwd_impl_id"]
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
return 0
}
@@ -682,7 +682,7 @@
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "pwd_impl_id"]
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
set authority_pretty_name [auth::authority::get_element -authority_id $authority_id -element "pretty_name"]
error "The authority '$authority_pretty_name' doesn't support password management"
}
@@ -717,7 +717,7 @@
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "pwd_impl_id"]
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
set authority_pretty_name [auth::authority::get_element -authority_id $authority_id -element "pretty_name"]
error "The authority '$authority_pretty_name' doesn't support password management"
}
@@ -749,7 +749,7 @@
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "pwd_impl_id"]
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
set authority_pretty_name [auth::authority::get_element -authority_id $authority_id -element "pretty_name"]
error "The authority '$authority_pretty_name' doesn't support password management"
}
Index: openacs-4/packages/acs-authentication/tcl/sync-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/sync-procs.tcl,v
diff -u -r1.32 -r1.33
--- openacs-4/packages/acs-authentication/tcl/sync-procs.tcl 12 Mar 2004 13:44:53 -0000 1.32
+++ openacs-4/packages/acs-authentication/tcl/sync-procs.tcl 10 Jan 2007 21:22:01 -0000 1.33
@@ -74,7 +74,7 @@
@author Lars Pind (lars@collaboraid.biz)
} {
- if { ![empty_string_p $job_id] } {
+ if { $job_id ne "" } {
util_memoize_flush [list auth::sync::job::get_authority_id_not_cached $job_id]
} else {
util_memoize_flush_regexp [list auth::sync::job::get_authority_id_not_cached .*]
@@ -125,11 +125,11 @@
@author Lars Pind (lars@collaboraid.biz)
} {
db_transaction {
- if { [empty_string_p $job_id] } {
+ if { $job_id eq "" } {
set job_id [db_nextval "auth_batch_jobs_job_id_seq"]
}
- if { $interactive_p && [empty_string_p $creation_user] } {
+ if { $interactive_p && $creation_user eq "" } {
set creation_user [ad_conn user_id]
}
@@ -309,7 +309,7 @@
@return entry_id of newly created entry
} {
- if { ![string equal $operation "delete"] && [empty_string_p $array] } {
+ if { $operation ne "delete" && $array eq "" } {
error "Switch -array is required when operation is not delete"
}
upvar 1 $array user_info
@@ -332,7 +332,7 @@
switch $operation {
snapshot {
- if { ![empty_string_p $user_id] } {
+ if { $user_id ne "" } {
# user exists, it's an update
set operation "update"
} else {
@@ -341,23 +341,23 @@
}
}
update - delete {
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
# Updating/deleting a user that doesn't exist
set success_p 0
set result(message) "A user with username '$username' does not exist"
} else {
acs_user::get -user_id $user_id -array existing_user_info
- if { [string equal $existing_user_info(member_state) "banned"] } {
+ if {$existing_user_info(member_state) eq "banned"} {
# Updating/deleting a user that's already deleted
set success_p 0
set result(message) "The user with username '$username' has been deleted (banned)"
}
}
}
insert {
- if { ![empty_string_p $user_id] } {
+ if { $user_id ne "" } {
acs_user::get -user_id $user_id -array existing_user_info
- if { ![string equal $existing_user_info(member_state) "banned"] } {
+ if { $existing_user_info(member_state) ne "banned" } {
# Inserting a user that already exists (and is not deleted)
set success_p 0
set result(message) "A user with username '$username' already exists"
@@ -379,7 +379,7 @@
-username $username \
-array user_info]
- if { ![string equal $result(creation_status) "ok"] } {
+ if { $result(creation_status) ne "ok" } {
set result(message) $result(creation_message)
set success_p 0
} else {
@@ -433,7 +433,7 @@
-username $username \
-array user_info]
- if { ![string equal $result(update_status) "ok"] } {
+ if { $result(update_status) ne "ok" } {
set result(message) $result(update_message)
set success_p 0
} else {
@@ -445,7 +445,7 @@
-authority_id $authority_id \
-username $username]
- if { ![string equal $result(delete_status) "ok"] } {
+ if { $result(delete_status) ne "ok" } {
set result(message) $result(delete_message)
set success_p 0
} else {
@@ -533,8 +533,8 @@
These should not be editable by the user. Supply either user_id or authority_id.
Authority_id is the most efficient.
} {
- if { [empty_string_p $authority_id] } {
- if { [empty_string_p $user_id] } {
+ if { $authority_id eq "" } {
+ if { $user_id eq "" } {
error "You must supply either user_id or authority_id"
}
set authority_id [acs_user::get_element -user_id $user_id -element authority_id]
@@ -567,7 +567,7 @@
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "get_doc_impl_id"]
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
# No implementation of GetDocument
set authority_pretty_name [auth::authority::get_element -authority_id $authority_id -element "pretty_name"]
error "The authority '$authority_pretty_name' doesn't support GetDocument"
@@ -594,7 +594,7 @@
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "process_doc_impl_id"]
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
# No implementation of auth_sync_process
set authority_pretty_name [auth::authority::get_element -authority_id $authority_id -element "pretty_name"]
error "The authority '$authority_pretty_name' doesn't support auth_sync_process"
@@ -621,7 +621,7 @@
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "process_doc_impl_id"]
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
# No implementation of auth_sync_process
set authority_pretty_name [auth::authority::get_element -authority_id $authority_id -element "pretty_name"]
error "The authority '$authority_pretty_name' doesn't support auth_sync_process"
@@ -646,7 +646,7 @@
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "process_doc_impl_id"]
- if { [empty_string_p $impl_id] } {
+ if { $impl_id eq "" } {
# No implementation of auth_sync_process
set authority_pretty_name [auth::authority::get_element -authority_id $authority_id -element "pretty_name"]
error "The authority '$authority_pretty_name' doesn't support auth_sync_process"
@@ -721,8 +721,8 @@
array set param $parameters
- if { (![empty_string_p $param(SnapshotURL)] && [string equal [clock format [clock seconds] -format "%d"] "01"]) || \
- [empty_string_p $param(IncrementalURL)] } {
+ if { ($param(SnapshotURL) ne "" && [string equal [clock format [clock seconds] -format "%d"] "01"]) || \
+ $param(IncrementalURL) eq "" } {
# On the first day of the month, we get a snapshot
set url $param(SnapshotURL)
@@ -732,7 +732,7 @@
set url $param(IncrementalURL)
}
- if { [empty_string_p $url] } {
+ if { $url eq "" } {
error "You must specify at least one URL to get."
}
@@ -798,8 +798,8 @@
array set param $parameters
- if { (![empty_string_p $param(SnapshotPath)] && [string equal [clock format [clock seconds] -format "%d"] "01"]) || \
- [empty_string_p $param(IncrementalPath)] } {
+ if { ($param(SnapshotPath) ne "" && [string equal [clock format [clock seconds] -format "%d"] "01"]) || \
+ $param(IncrementalPath) eq "" } {
# On the first day of the month, we get a snapshot
set path $param(SnapshotPath)
@@ -809,7 +809,7 @@
set path $param(IncrementalPath)
}
- if { [empty_string_p $path] } {
+ if { $path eq "" } {
error "You must specify at least one path to get."
}
@@ -883,7 +883,7 @@
set root_node [xml_doc_get_first_node $tree]
- if { ![string equal [xml_node_get_name $root_node] "enterprise"] } {
+ if { [xml_node_get_name $root_node] ne "enterprise" } {
error "Root node was not <enterprise>"
}
@@ -916,9 +916,9 @@
set user_info(first_names) [xml_get_child_node_content_by_path $person_node { { name n given } }]
set user_info(last_name) [xml_get_child_node_content_by_path $person_node { { name n family } }]
- if { [empty_string_p $user_info(first_names)] || [empty_string_p $user_info(last_name)] } {
+ if { $user_info(first_names) eq "" || $user_info(last_name) eq "" } {
set formatted_name [xml_get_child_node_content_by_path $person_node { { name fn } }]
- if { ![empty_string_p $formatted_name] || [string first " " $formatted_name] > -1 } {
+ if { $formatted_name ne "" || [string first " " $formatted_name] > -1 } {
# Split, so everything up to the last space goes to first_names, the rest to last_name
regexp {^(.+) ([^ ]+)$} $formatted_name match user_info(first_names) user_info(last_name)
}
@@ -943,7 +943,7 @@
} {
set tree [xml_parse -persist $document]
set root_node [xml_doc_get_first_node $tree]
- if { ![string equal [xml_node_get_name $root_node] "enterprise"] } {
+ if { [xml_node_get_name $root_node] ne "enterprise" } {
error "Root node was not <enterprise>"
}
Index: openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl,v
diff -u -r1.37 -r1.38
--- openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl 28 Oct 2006 20:56:05 -0000 1.37
+++ openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl 10 Jan 2007 21:22:01 -0000 1.38
@@ -56,7 +56,7 @@
-password "blabla"]
aa_equals "auth_status for bad password authentication" $auth_info(auth_status) "bad_password"
- aa_true "auth_message for bad password authentication" ![empty_string_p $auth_info(auth_message)]
+ aa_true "auth_message for bad password authentication" [expr {$auth_info(auth_message) ne ""}]
# Blank password
array unset auth_info
@@ -67,7 +67,7 @@
-password ""]
aa_equals "auth_status for blank password authentication" $auth_info(auth_status) "bad_password"
- aa_true "auth_message for blank password authentication" ![empty_string_p $auth_info(auth_message)]
+ aa_true "auth_message for blank password authentication" [expr {$auth_info(auth_message) ne ""}]
# Incorrect username
array unset auth_info
@@ -78,7 +78,7 @@
-password $password]
aa_equals "auth_status for bad username authentication" $auth_info(auth_status) "no_account"
- aa_true "auth_message for bad username authentication" ![empty_string_p $auth_info(auth_message)]
+ aa_true "auth_message for bad username authentication" [expr {$auth_info(auth_message) ne ""}]
# Blank username
array unset auth_info
@@ -89,7 +89,7 @@
-password $password]
aa_equals "auth_status for blank username authentication" $auth_info(auth_status) "auth_error"
- aa_true "auth_message for blank username authentication" ![empty_string_p $auth_info(auth_message)]
+ aa_true "auth_message for blank username authentication" [expr {$auth_info(auth_message) ne ""}]
# Authority bogus
array unset auth_info
@@ -101,7 +101,7 @@
-password $password]
aa_equals "auth_status for bad authority_id authentication" $auth_info(auth_status) "failed_to_connect"
- aa_true "auth_message for bad authority_id authentication" ![empty_string_p $auth_info(auth_message)]
+ aa_true "auth_message for bad authority_id authentication" [expr {$auth_info(auth_message) ne ""}]
# Closed account status
set closed_states {banned rejected "needs approval" deleted}
@@ -117,7 +117,7 @@
-password $password]
aa_equals "auth_status for '$closed_state' user" $auth_info(auth_status) "ok"
- if { [string equal $auth_info(auth_status) "ok"] } {
+ if {$auth_info(auth_status) eq "ok"} {
# Only perform this test if auth_status is ok, otherwise account_status won't be set
aa_equals "account_status for '$closed_state' user" $auth_info(account_status) "closed"
}
@@ -157,7 +157,7 @@
if { [info exists user_info(creation_status)] } {
aa_equals "creation_status for successful creation" $user_info(creation_status) "ok"
- if { ![string equal $user_info(creation_status) "ok"] } {
+ if { $user_info(creation_status) ne "ok" } {
aa_log "Element messages: '$user_info(element_messages)'"
aa_log "Element messages: '$user_info(creation_message)'"
}
@@ -284,8 +284,8 @@
aa_log "Elements array: '[array get element_array]'"
- aa_true "there is more than one required element" [expr [llength $element_array(required)] > 0]
- aa_true "there is more than one optional element" [expr [llength $element_array(optional)] > 0]
+ aa_true "there is more than one required element" [expr {[llength $element_array(required)] > 0}]
+ aa_true "there is more than one optional element" [expr {[llength $element_array(optional)] > 0}]
}
aa_register_case \
@@ -296,7 +296,7 @@
} {
set form_elements [auth::get_registration_form_elements]
- aa_true "Form elements are not empty: $form_elements" [expr ![empty_string_p $form_elements]]
+ aa_true "Form elements are not empty: $form_elements" [expr {$form_elements ne ""}]
}
###########
@@ -414,7 +414,7 @@
-username $test_vars(username)]
aa_equals "status ok" $password_result(password_status) "ok"
- aa_true "non-empty message" [expr ![empty_string_p $password_result(password_message)]]
+ aa_true "non-empty message" [expr {$password_result(password_message) ne ""}]
}
}
@@ -451,7 +451,7 @@
-username $test_vars(username)]
aa_equals "retrieve pwd from local auth" $result(password_status) "ok"
- aa_true "must have message on failure" [expr ![empty_string_p $result(password_message)]]
+ aa_true "must have message on failure" [expr {$result(password_message) ne ""}]
}
aa_register_case \
@@ -484,7 +484,7 @@
-secret_question "foo" \
-secret_answer "bar"]
aa_equals "status should be ok for creating user" $create_result(creation_status) "ok"
- if { ![string equal $create_result(creation_status) "ok"] } {
+ if { $create_result(creation_status) ne "ok" } {
aa_log "Create-result: '[array get create_result]'"
}
@@ -606,7 +606,7 @@
set parameters [array names parameters_array]
- aa_true "List of parameters is not empty" [expr [llength $parameters] != 0]
+ aa_true "List of parameters is not empty" [expr {[llength $parameters] != 0}]
array set values [list]
@@ -671,7 +671,7 @@
# GetElements
array set elms [auth::get_registration_elements]
- aa_true "Registration elements do NOT contain username" [expr [lsearch [concat $elms(required) $elms(optional)] "username"] == -1]
+ aa_true "Registration elements do NOT contain username" [expr {[lsearch [concat $elms(required) $elms(optional)] "username"] == -1}]
# Create a user with no username
set email [string tolower "[ad_generate_random_string]@foobar.com"]
Index: openacs-4/packages/acs-authentication/tcl/test/sync-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/test/sync-test-procs.tcl,v
diff -u -r1.18 -r1.19
--- openacs-4/packages/acs-authentication/tcl/test/sync-test-procs.tcl 17 Feb 2004 15:21:51 -0000 1.18
+++ openacs-4/packages/acs-authentication/tcl/test/sync-test-procs.tcl 10 Jan 2007 21:22:01 -0000 1.19
@@ -51,7 +51,7 @@
# End job
array set job [auth::sync::job::end -job_id $job_id]
- aa_true "Elapsed time less than 30 seconds" [expr $job(run_time_seconds) < 30]
+ aa_true "Elapsed time less than 30 seconds" [expr {$job(run_time_seconds) < 30}]
aa_log "Elapsed time: $job(run_time_seconds) seconds"
@@ -61,7 +61,7 @@
aa_equals "Number of problems" $job(num_problems) 1
- aa_false "Log URL non-empty" [empty_string_p $job(log_url)]
+ aa_false "Log URL non-empty" [expr {$job(log_url) eq ""}]
# Purge not deleting the job
auth::sync::purge_jobs \
@@ -323,15 +323,15 @@
array set job [auth::sync::job::end -job_id $job_id]
- aa_true "Elapsed time less than 30 seconds" [expr $job(run_time_seconds) < 30]
+ aa_true "Elapsed time less than 30 seconds" [expr {$job(run_time_seconds) < 30}]
aa_false "Not interactive" [template::util::is_true $job(interactive_p)]
aa_equals "Number of actions" $job(num_actions) 6
aa_equals "Number of problems" $job(num_problems) 2
- aa_false "Log URL non-empty" [empty_string_p $job(log_url)]
+ aa_false "Log URL non-empty" [expr {$job(log_url) eq ""}]
}
}
@@ -465,15 +465,15 @@
array set job [auth::sync::job::end -job_id $job_id]
- aa_true "Elapsed time less than 30 seconds" [expr $job(run_time_seconds) < 30]
+ aa_true "Elapsed time less than 30 seconds" [expr {$job(run_time_seconds) < 30}]
aa_false "Not interactive" [template::util::is_true $job(interactive_p)]
- aa_equals "Number of actions" $job(num_actions) [expr $num_users_not_banned + 1]
+ aa_equals "Number of actions" $job(num_actions) [expr {$num_users_not_banned + 1}]
aa_equals "Number of problems" $job(num_problems) 0
- aa_false "Log URL non-empty" [empty_string_p $job(log_url)]
+ aa_false "Log URL non-empty" [expr {$job(log_url) eq ""}]
}
}
@@ -502,7 +502,7 @@
aa_stub acs_sc::invoke {
acs_sc::invoke__arg_parser
- if { [string equal $contract "auth_sync_retrieve"] && [string equal $operation "GetDocument"] } {
+ if { $contract eq "auth_sync_retrieve" && $operation eq "GetDocument" } {
array set result {
doc_status ok
doc_message {}
@@ -665,10 +665,10 @@
aa_true "email has a problem (email missing)" [util_sets_equal_p { email } [array names elm_msgs]]
}
update {
- aa_true "User does not exist" [expr ![empty_string_p $entry(message)]]
+ aa_true "User does not exist" [expr {$entry(message) ne ""}]
}
delete {
- aa_false "Message is not empty" [empty_string_p $entry(message)]
+ aa_false "Message is not empty" [expr {$entry(message) eq ""}]
}
}
}
@@ -685,7 +685,7 @@
aa_stub acs_sc::invoke {
acs_sc::invoke__arg_parser
- if { [string equal $contract "auth_sync_retrieve"] && [string equal $operation "GetDocument"] } {
+ if { $contract eq "auth_sync_retrieve" && $operation eq "GetDocument" } {
array set result {
doc_status ok
doc_message {}
@@ -957,7 +957,7 @@
aa_equals "result.doc_status is ok" $result(doc_status) "ok"
- aa_true "result.doc_message is empty" [empty_string_p $result(doc_message)]
+ aa_true "result.doc_message is empty" [expr {$result(doc_message) eq ""}]
aa_equals "result.document is 'success'" $result(document) "success"
}
@@ -976,6 +976,6 @@
-call_args [list [list SnapshotPath {} IncrementalPath $path]]]
aa_equals "result.doc_status is ok" $result(doc_status) "ok"
- aa_true "result.doc_message is empty" [empty_string_p $result(doc_message)]
+ aa_true "result.doc_message is empty" [expr {$result(doc_message) eq ""}]
aa_equals "result.document is 'success'" $result(document) [template::util::read_file $path]
}
Index: openacs-4/packages/acs-automated-testing/tcl/aa-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/tcl/aa-test-procs.tcl,v
diff -u -r1.36 -r1.37
--- openacs-4/packages/acs-automated-testing/tcl/aa-test-procs.tcl 14 Jul 2006 00:34:48 -0000 1.36
+++ openacs-4/packages/acs-automated-testing/tcl/aa-test-procs.tcl 10 Jan 2007 21:22:01 -0000 1.37
@@ -267,7 +267,7 @@
# If the component exists, execute the body code in the testcases stack
# level.
#
- if {$body != ""} {
+ if {$body ne ""} {
aa_log "Running component $component_id"
uplevel 1 "_${aa_package_key}__c_$component_id"
return
@@ -350,7 +350,7 @@
# run library specific code
foreach library $libraries {
- if { $library == "tclwebtest" } {
+ if { $library eq "tclwebtest" } {
# kludge: until tclwebtest installs itself in the proper
# place following the tcl way, we use this absolute path
@@ -375,7 +375,7 @@
#
set filtered_inits {}
foreach init_class $init_classes {
- if {[string trim $init_class] != ""} {
+ if {[string trim $init_class] ne ""} {
set found 0
foreach init_class_info [nsv_get aa_test init_classes] {
if {$init_class == [lindex $init_class_info 0]} {
@@ -420,7 +420,7 @@
nsv_lappend aa_test cases $test_case_list
}
- if { $case_error != "" } {
+ if { $case_error ne "" } {
# we don't source this file but insert a little warning text
# into the procs body. There seems to be no better way to
@@ -517,7 +517,7 @@
# Work out the list of initialisation classes.
#
set testcase_ids {}
- if {$testcase_id != ""} {
+ if {$testcase_id ne ""} {
lappend testcase_ids $testcase_id
foreach testcase [nsv_get aa_test cases] {
if {$testcase_id == [lindex $testcase 0]} {
@@ -705,7 +705,7 @@
global aa_testcase_id
global aa_package_key
- if { [string equal $affirm_actual $affirm_value] } {
+ if {$affirm_actual eq $affirm_value} {
aa_log_result "pass" "$affirm_name Affirm PASSED, actual = \"$affirm_actual\""
return 1
} else {
@@ -820,17 +820,17 @@
# entry, but don't write it to the database. Individual testcase will make
# their own copies of these log entries.
#
- if {$aa_in_init_class != ""} {
+ if {$aa_in_init_class ne ""} {
lappend aa_init_class_logs($aa_in_init_class) \
[list $test_result $test_notes]
return
}
incr aa_testcase_test_id
- if {$test_result == "pass"} {
+ if {$test_result eq "pass"} {
ns_log Debug "aa_log_result: PASSED: $aa_testcase_id, $test_notes"
incr aa_testcase_passes
- } elseif {$test_result == "fail"} {
+ } elseif {$test_result eq "fail"} {
switch $aa_error_level {
notice {
ns_log notice "aa_log_result: NOTICE: $aa_testcase_id, $test_notes"
@@ -935,7 +935,7 @@
# Teardown
set teardown_error_p 0
- if { ![empty_string_p $teardown_code] } {
+ if { $teardown_code ne "" } {
set teardown_error_p [catch {uplevel $teardown_code} teardown_error]
global errorInfo
set teardown_error_stack $errorInfo
@@ -949,7 +949,7 @@
if { $teardown_error_p } {
append error_text "\n\nTeardown failed with error $teardown_error\n\n$teardown_error_stack"
}
- if { ![empty_string_p $error_text] } {
+ if { $error_text ne "" } {
error $error_text
}
}
@@ -1061,13 +1061,13 @@
set service(parse_errors) {}
set service(name) [xml_node_get_attribute $root_node "name"]
- if { [empty_string_p $service(name)] } {
+ if { $service(name) eq "" } {
append service(parse_error) "No service name attribute;"
}
foreach child [xml_node_get_children $root_node] {
set info_type [xml_node_get_attribute $child "type"]
- if { [empty_string_p $info_type] } {
+ if { $info_type eq "" } {
append service(parse_error) "No type on info tag;"
continue
}
@@ -1077,7 +1077,7 @@
}
if { [string is integer -strict $service(install_begin_epoch)] && [string is integer -strict $service(install_end_epoch)] } {
- set service(install_duration) [expr $service(install_end_epoch) - $service(install_begin_epoch)]
+ set service(install_duration) [expr {$service(install_end_epoch) - $service(install_begin_epoch)}]
set service(install_duration_pretty) [util::interval_pretty -seconds $service(install_duration)]
}
Index: openacs-4/packages/acs-automated-testing/tcl/filter-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/tcl/filter-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-automated-testing/tcl/filter-procs.tcl 11 Nov 2001 18:03:52 -0000 1.1
+++ openacs-4/packages/acs-automated-testing/tcl/filter-procs.tcl 10 Jan 2007 21:22:01 -0000 1.2
@@ -2,8 +2,8 @@
Checks whether a view_by value has a value of "testcase", "package" or
"category"
} {
- if {$value != "testcase" &&
- $value != "package"} {
+ if {$value ne "testcase" &&
+ $value ne "package"} {
ad_complain "Invalid view_by name"
return 0
}
Index: openacs-4/packages/acs-automated-testing/tcl/tclwebtest-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/tcl/tclwebtest-procs.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-automated-testing/tcl/tclwebtest-procs.tcl 14 Jul 2006 00:25:55 -0000 1.5
+++ openacs-4/packages/acs-automated-testing/tcl/tclwebtest-procs.tcl 10 Jan 2007 21:22:01 -0000 1.6
@@ -77,7 +77,7 @@
set ip_address [ns_config ns/server/[ns_info server]/module/nssock Address]
# If the IP is not configured in the config.tcl we will use the ip of localhost
- if {[empty_string_p $ip_address]} {
+ if {$ip_address eq ""} {
set ip_address 127.0.0.1
}
@@ -123,7 +123,7 @@
-secret_question [ad_generate_random_string] \
-secret_answer [ad_generate_random_string]]
- if { ![string equal $user_info(creation_status) ok] } {
+ if { $user_info(creation_status) ne "ok" } {
# Could not create user
error "Could not create test user with username=$username user_info=[array get user_info]"
}
Index: openacs-4/packages/acs-automated-testing/www/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/www/index.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-automated-testing/www/index.tcl 26 Feb 2004 13:36:50 -0000 1.4
+++ openacs-4/packages/acs-automated-testing/www/index.tcl 10 Jan 2007 21:22:02 -0000 1.5
@@ -14,7 +14,7 @@
multirow create servers path admin_login_url local_url remote_url name description install_date error_total_count parse_errors
set xml_report_dir [aa_test::xml_report_dir]
-if { ![empty_string_p $xml_report_dir] } {
+if { $xml_report_dir ne "" } {
foreach path [glob $xml_report_dir/*-installreport.xml] {
aa_test::parse_install_file -path $path -array service
Index: openacs-4/packages/acs-automated-testing/www/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/www/admin/index.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-automated-testing/www/admin/index.tcl 24 Feb 2005 22:10:51 -0000 1.6
+++ openacs-4/packages/acs-automated-testing/www/admin/index.tcl 10 Jan 2007 21:22:02 -0000 1.7
@@ -22,10 +22,10 @@
}
set title "System test cases"
-if {$by_package_key != ""} {
+if {$by_package_key ne ""} {
append title " for package $by_package_key"
}
-if {$by_category != ""} {
+if {$by_category ne ""} {
append title ", category $by_category"
} else {
append title ", all categories"
@@ -54,11 +54,11 @@
# If viewing by package, update the by-package results, taking into
# account whether a specific category has been specified.
#
- if {$view_by == "package"} {
+ if {$view_by eq "package"} {
set package_total [lindex $packages($package_key) 0]
set package_pass [lindex $packages($package_key) 1]
set package_fail [lindex $packages($package_key) 2]
- if {$by_category != ""} {
+ if {$by_category ne ""} {
# Category specific, only add results if this testcase is of the
# specified category.
set categories [lindex $results("$testcase_id,$package_key") 2]
@@ -81,7 +81,7 @@
}
}
-if {$view_by == "package"} {
+if {$view_by eq "package"} {
#
# Prepare the template data for a view_by "package"
#
@@ -115,8 +115,8 @@
# - The package key is blank or it matches the specified.
# - The category is blank or it matches the specified.
#
- if {($by_package_key == "" || ($by_package_key == $package_key)) && \
- ($by_category == "" || ([lsearch $categories $by_category] != -1))} {
+ if {($by_package_key eq "" || ($by_package_key == $package_key)) && \
+ ($by_category eq "" || ([lsearch $categories $by_category] != -1))} {
# Swap the highlight flag between packages.
if {$old_package_key != $package_key} {
set marker 1
Index: openacs-4/packages/acs-automated-testing/www/admin/proc-coverage.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/www/admin/proc-coverage.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-automated-testing/www/admin/proc-coverage.tcl 15 Feb 2004 12:14:37 -0000 1.1
+++ openacs-4/packages/acs-automated-testing/www/admin/proc-coverage.tcl 10 Jan 2007 21:22:02 -0000 1.2
@@ -19,7 +19,7 @@
foreach testcase [nsv_get aa_test cases] {
set testcase_package_key [lindex $testcase 3]
- if { [string equal $testcase_package_key $package_key] } {
+ if {$testcase_package_key eq $package_key} {
set tested_procs [lindex $testcase 10]
if { [llength $tested_procs] > 0 } {
set tested_proc_names [concat $tested_proc_names $tested_procs]
Index: openacs-4/packages/acs-automated-testing/www/admin/rerun.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/www/admin/rerun.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-automated-testing/www/admin/rerun.tcl 16 Feb 2004 16:47:28 -0000 1.3
+++ openacs-4/packages/acs-automated-testing/www/admin/rerun.tcl 10 Jan 2007 21:22:02 -0000 1.4
@@ -11,7 +11,7 @@
} -properties {
}
-if {$testcase_id == ""} {
+if {$testcase_id eq ""} {
if {$quiet} {
aa_runseries -stress $stress -security_risk $security_risk -quiet $package_key $category
} else {
Index: openacs-4/packages/acs-bootstrap-installer/bootstrap.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/bootstrap.tcl,v
diff -u -r1.28 -r1.29
--- openacs-4/packages/acs-bootstrap-installer/bootstrap.tcl 18 Dec 2006 11:23:06 -0000 1.28
+++ openacs-4/packages/acs-bootstrap-installer/bootstrap.tcl 10 Jan 2007 21:22:02 -0000 1.29
@@ -177,7 +177,7 @@
# thrown by a call to bootstrap_fatal_error. If not, bootstrap_fatal_error was
# never called, so we need to call it now.
global errorCode
- if { [string compare $errorCode "bootstrap_fatal_error"] } {
+ if {$errorCode ne "bootstrap_fatal_error" } {
bootstrap_fatal_error "Error during bootstrapping" 0
}
}
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.7 -r1.8
--- openacs-4/packages/acs-bootstrap-installer/db-init-checks-oracle.tcl 13 Nov 2006 21:31:58 -0000 1.7
+++ openacs-4/packages/acs-bootstrap-installer/db-init-checks-oracle.tcl 10 Jan 2007 21:22:02 -0000 1.8
@@ -10,7 +10,7 @@
upvar $error_p my_error_p
foreach pool [db_available_pools {}] {
- if { [catch { set db [ns_db gethandle -timeout 15 $pool]}] || ![string compare $db ""] } {
+ if { [catch { set db [ns_db gethandle -timeout 15 $pool]}] || $db eq "" } {
# This should never happened - we were able to grab a handle previously, why not now?
append my_errors "(db_bootstrap_checks) Internal error accessing pool \"$pool\".<br>"
set my_error_p 1
Index: openacs-4/packages/acs-bootstrap-installer/db-init-checks-postgresql.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/db-init-checks-postgresql.tcl,v
diff -u -r1.12 -r1.13
--- openacs-4/packages/acs-bootstrap-installer/db-init-checks-postgresql.tcl 30 Oct 2006 01:13:13 -0000 1.12
+++ openacs-4/packages/acs-bootstrap-installer/db-init-checks-postgresql.tcl 10 Jan 2007 21:22:02 -0000 1.13
@@ -12,7 +12,7 @@
set my_errors "We found the following problems with your PostgreSQL installation:<p><ul>\n"
foreach pool [db_available_pools {}] {
- if { [catch { set db [ns_db gethandle -timeout 15 $pool]}] || ![string compare $db ""] } {
+ if { [catch { set db [ns_db gethandle -timeout 15 $pool]}] || $db eq "" } {
# This should never happened - we were able to grab a handle previously, why not now?
append my_errors "<li>(db_bootstrap_checks) Internal error accessing pool \"$pool\".<br>"
set my_error_p 1
Index: openacs-4/packages/acs-bootstrap-installer/installer.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/installer.tcl,v
diff -u -r1.19 -r1.20
--- openacs-4/packages/acs-bootstrap-installer/installer.tcl 5 Jun 2006 00:02:36 -0000 1.19
+++ openacs-4/packages/acs-bootstrap-installer/installer.tcl 10 Jan 2007 21:22:02 -0000 1.20
@@ -24,7 +24,7 @@
} {
set type_attribute [ad_decode $type "" "" "type=\"$type\""]
- if { ![empty_string_p $value] } {
+ if { $value ne "" } {
append extra_attributes " value=\"[ad_quotehtml $value]\""
}
@@ -45,7 +45,7 @@
} {
array set mandatory_params_array [install_mandatory_params]
set mandatory_names [array names mandatory_params_array]
- return [expr [lsearch -exact $mandatory_names $param_name] != -1]
+ return [expr {[lsearch -exact $mandatory_names $param_name] != -1}]
}
ad_proc -private install_mandatory_params {} {
@@ -102,7 +102,7 @@
set form [ns_getform]
set missing_params [list]
- if { [empty_string_p $form] } {
+ if { $form eq "" } {
# Form is empty - all mandatory params are missing
foreach param_name [array names mandatory_params_array] {
lappend missing_params $mandatory_params_array($param_name)
@@ -115,9 +115,9 @@
[array names optional_params_array]]
foreach param_name $all_param_names {
set param_value [ns_set iget $form $param_name]
- set mandatory_p [expr [lsearch -exact $mandatory_params $param_name] != -1]
+ set mandatory_p [expr {[lsearch -exact $mandatory_params $param_name] != -1}]
- if { ![empty_string_p $param_value] } {
+ if { $param_value ne "" } {
# Param in form - set value in callers scope
uplevel [list set $param_name $param_value]
} else {
@@ -157,7 +157,7 @@
# Prefix the page title
set page_title_prefix "OpenACS Installation"
- if { ![empty_string_p $title] } {
+ if { $title ne "" } {
set page_title "${page_title_prefix}: $title"
} else {
set page_title $page_title_prefix
@@ -267,7 +267,7 @@
# is still working.
if { [regexp {/SYSTEM/(.*)} [ad_conn url] "" system_file] } {
if {[string compare [string range $system_file \
- [expr [string length $system_file ] - 4] end] ".tcl"
+ [expr {[string length $system_file ] - 4}] end] ".tcl"
]} {
set system_file "$system_file.tcl"
}
@@ -280,7 +280,7 @@
return
}
- if { ![string compare $script ""] } {
+ if { $script eq "" } {
set script "index"
}
@@ -344,7 +344,7 @@
Note, this procedure is a best guess, not sure of a better way of determining:
} {
set thisplatform [ns_info platform]
- if {[string equal $thisplatform "win32" ]} {
+ if {$thisplatform eq "win32"} {
return 1
} else {
return 0
Index: openacs-4/packages/acs-bootstrap-installer/installer/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/installer/index.tcl,v
diff -u -r1.24 -r1.25
--- openacs-4/packages/acs-bootstrap-installer/installer/index.tcl 8 Jan 2007 23:57:25 -0000 1.24
+++ openacs-4/packages/acs-bootstrap-installer/installer/index.tcl 10 Jan 2007 21:22:02 -0000 1.25
@@ -64,7 +64,7 @@
# Parse the xml document
set root_node [apm_load_install_xml_file]
- if { ![string equal [xml_node_get_name $root_node] application] } {
+ if { [xml_node_get_name $root_node] ne "application" } {
error "Installer: Could not find root node application in install.xml file"
}
@@ -77,7 +77,7 @@
application after the basic OpenACS tookit has been installed.
"
- if { ![string equal $acs_application(home) ""] } {
+ if { $acs_application(home) ne "" } {
append body "<p>
For more information about the $acs_application(pretty_name) application visit the
<a href=\"$acs_application(home)\">$acs_application(pretty_name) home page</a>
@@ -172,7 +172,7 @@
# AOLserver must support the "fancy" ADP parser.
set adp_support [ns_config "ns/server/[ns_info server]/adp" DefaultParser]
-if { [string compare $adp_support "fancy"] } {
+if {$adp_support ne "fancy" } {
append errors "<li><p><strong>The fancy ADP parser is not enabled. This is required to support
the OpenACS Templating System. Without this templating system, none of the OpenACS pages installed by default
will display. Please add the following to your AOLserver configuration file (usually in
@@ -194,14 +194,14 @@
set stacksize [ns_config "ns/threads" StackSize]
if { ![string is integer $stacksize] ||
- $stacksize < [expr $acs_application(min_stack_size) * 1024] } {
+ $stacksize < [expr {$acs_application(min_stack_size) * 1024}] } {
append errors "<li><p><strong>The configured AOLserver Stacksize is too small, missing, or a non-integer value.
$acs_application(pretty_name) requires a StackSize parameter of at least
${acs_application(min_stack_size)}K.
<p>Please add the following line to your .tcl configuration file
<blockquote><pre>
ns_section \"ns/threads\"
- ns_param StackSize \[expr ${acs_application(min_stack_size)}*1024\]
+ ns_param StackSize \[expr {${acs_application(min_stack_size)}*1024}\]
</blockquote></pre>
After adding support the larger stacksize, please restart your web server.
</strong></p>"
Index: openacs-4/packages/acs-bootstrap-installer/installer/install.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/installer/install.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-bootstrap-installer/installer/install.tcl 26 Jan 2005 21:07:23 -0000 1.9
+++ openacs-4/packages/acs-bootstrap-installer/installer/install.tcl 10 Jan 2007 21:22:02 -0000 1.10
@@ -19,7 +19,7 @@
#
#############
-if { [string compare $password $password_confirmation] } {
+if {$password ne $password_confirmation } {
install_return 200 "Passwords Don't Match" "
The passwords you've entered don't match. Please <a href=\"javascript:history.back()\">try again</a>.
"
@@ -51,7 +51,7 @@
install_do_packages_install
-if { [empty_string_p $username] } {
+if { $username eq "" } {
set username $email
}
@@ -173,7 +173,7 @@
<p> If not, please check your server error log, or contact your system administrator. </p>"
-if { ![string equal $post_installation_message ""] } {
+if { $post_installation_message ne "" } {
ns_write $post_installation_message
} else {
ns_write "
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.36 -r1.37
--- openacs-4/packages/acs-bootstrap-installer/tcl/00-proc-procs.tcl 13 Jul 2006 18:03:10 -0000 1.36
+++ openacs-4/packages/acs-bootstrap-installer/tcl/00-proc-procs.tcl 10 Jan 2007 21:22:03 -0000 1.37
@@ -15,7 +15,7 @@
#
# Note that ACS 3.2 defined number_p like this:
#
- # if { [empty_string_p $var] } {
+ # if { $var eq "" } {
# return 0
# } else {
# return [regexp {^-?[0-9]*\.?[0-9]*$} $var match]
@@ -103,7 +103,7 @@
# If the argument is "--", stop parsing for switches (but
# bump up $i to the next argument, which is the first
# argument which is not a switch).
- if { [string equal $arg "--"] } {
+ if {$arg eq "--"} {
incr i
break
}
@@ -146,23 +146,23 @@
return -code error "Switch -warn can be provided to ad_proc only if -deprecated is also provided"
}
- if { ![string equal $impl ""] && [string equal $callback ""] } {
+ if { $impl ne "" && $callback eq "" } {
return -code error "A callback contract name must be specified with -callback when defining an implementation with -impl"
}
- if { [string equal $impl impl] || [string match $impl "impl::*"] } {
+ if { $impl eq "impl" || [string match $impl "impl::*"] } {
return -code error "Callback implementations may not be named impl"
}
- if { [string equal $callback contract] || [string match $callback "contract::*"] } {
+ if { $callback eq "contract" || [string match $callback "contract::*"] } {
return -code error "Callbacks may not be named contract"
}
# Now $i is set to the index of the first non-switch argument.
# There must be either three or four arguments remaining.
set n_args_remaining [expr { [llength $args] - $i }]
- if {[string equal $callback ""]} {
+ if {$callback eq ""} {
# We are creating a normal proc so the proc name is an argument
if { $n_args_remaining < 3 || $n_args_remaining > 4} {
return -code error "Wrong number of arguments passed to ad_proc"
@@ -171,27 +171,27 @@
# Set up the remaining arguments.
set proc_name [lindex $args $i]
} else {
- if {![string equal $impl ""]} {
+ if {$impl ne "" } {
# We are creating an implementation...
if {$n_args_remaining != 3} {
return -code error "ad_proc callback implementation must have: arguments (can be empty) docs code_body"
}
}
- if {[string equal $impl ""]} {
+ if {$impl eq ""} {
# We are creating an callback contract...
if {!( $n_args_remaining == 3 || $n_args_remaining == 2 ) } {
return -code error "ad_proc callback contract must have: arguments docs \[empty_code_body\]"
} elseif {$n_args_remaining == 3
- && ![string equal [lindex $args end] ""]
- && ![string equal [lindex $args end] "-"]} {
+ && [lindex $args end] ne ""
+ && [lindex $args end] ne "-" } {
return -code error "ad_proc callback contract must have an empty code_body"
}
}
set callback [string trimleft $callback ::]
set proc_name ::callback::${callback}
- if {[string equal $impl ""]} {
+ if {$impl eq ""} {
append proc_name ::contract
} else {
append proc_name ::impl::${impl}
@@ -219,23 +219,23 @@
set proc_name_as_passed $proc_name
set parent_namespace [string trimleft [uplevel 1 {::namespace current}] ::]
- if { ![string match ::* $proc_name] } {
+ if { ![string match "::*" $proc_name] } {
set proc_name ${parent_namespace}::$proc_name
}
- if {![string eq $parent_namespace {}] && ![string match ::* $proc_name]} {
+ if {$parent_namespace ne {} && ![string match "::*" $proc_name]} {
ns_log Debug "proc $proc_name_as_passed declared in namespace $parent_namespace via namespace eval; coding standard is to declare as $proc_name"
}
set proc_name [string trimleft $proc_name ::]
- if { ![string equal $callback ""] } {
+ if { $callback ne "" } {
# Do a namespace eval of each namespace to ensure it exists
set namespaces [split $proc_name ::]
set namespaces [lrange $namespaces 0 end-1]
set curr_ns ""
foreach ns $namespaces {
- if {![string equal $ns ""]} {
+ if {$ns ne "" } {
append curr_ns "::$ns"
namespace eval $curr_ns {}
}
@@ -253,8 +253,8 @@
}
set code_block [lindex $args end]
- if {![string equal $callback ""]
- && ![string equal $impl ""] } {
+ if {$callback ne ""
+ && $impl ne "" } {
if {[info exists doc_elements(see)]} {
lappend doc_elements(see) "callback::${callback}::contract"
} else {
@@ -317,7 +317,7 @@
set arg [lindex $arg_split 0]
foreach flag [split [lindex $arg_split 1] ","] {
set flag [string trim $flag]
- if { ![string equal $flag "required"] && ![string equal $flag "boolean"] } {
+ if { $flag ne "required" && $flag ne "boolean" } {
return -code error "Invalid flag \"$flag\""
}
lappend arg_flags $flag
@@ -326,7 +326,7 @@
return -code error "Invalid element \"$arg\" in argument list"
}
- if { [string equal [string index $arg 0] "-"] } {
+ if {[string index $arg 0] eq "-"} {
if { [llength $positionals] > 0 } {
return -code error "Switch -$arg specified after positional parameter"
}
@@ -405,13 +405,13 @@
# Backward compatibility: set proc_doc and proc_source_file
nsv_set proc_doc $proc_name [lindex $doc_elements(main) 0]
if { [nsv_exists proc_source_file $proc_name] \
- && [string compare [nsv_get proc_source_file $proc_name] [info script]] != 0 } {
+ && [nsv_get proc_source_file $proc_name] ne [info script] } {
ns_log Warning "Multiple definition of $proc_name in [nsv_get proc_source_file $proc_name] and [info script]"
}
nsv_set proc_source_file $proc_name [info script]
- if { [string equal $code_block "-"] } {
- if { [string equal $callback ""] } {
+ if {$code_block eq "-"} {
+ if {$callback eq ""} {
return
} else {
# we are creating a callback so create an empty body
@@ -605,7 +605,7 @@
\@param user_id The id for the user to process. Optional with default ""
(api-browser will show the default automatically)
} {
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
# Do something if this is not an empty string
}
@@ -670,7 +670,7 @@
@error if the list of command-line options is not valid.
} {
- if { [string equal [lindex $allowed_args end] "args"] } {
+ if {[lindex $allowed_args end] eq "args"} {
set varargs_p 1
set allowed_args [lrange $allowed_args 0 [expr { [llength $allowed_args] - 2 }]]
} else {
@@ -684,7 +684,7 @@
set counter 0
foreach { switch value } $argv {
- if { ![string equal [string index $switch 0] "-"] } {
+ if { [string index $switch 0] ne "-" } {
if { $varargs_p } {
set args [lrange $argv $counter end]
return
@@ -768,7 +768,7 @@
@see ad_proc
} {
- if {$callback == ""} {
+ if {$callback eq ""} {
error "callback: no callback name given"
}
# see that the contract exists and call the contract for
Index: openacs-4/packages/acs-bootstrap-installer/tcl/10-utilities-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/tcl/10-utilities-procs.tcl,v
diff -u -r1.7 -r1.8
--- openacs-4/packages/acs-bootstrap-installer/tcl/10-utilities-procs.tcl 25 Sep 2003 11:37:32 -0000 1.7
+++ openacs-4/packages/acs-bootstrap-installer/tcl/10-utilities-procs.tcl 10 Jan 2007 21:22:03 -0000 1.8
@@ -45,7 +45,7 @@
# Remember that we've examined the file.
set examined_files($file) 1
- if { [empty_string_p $check_file_func] || [eval [list $check_file_func $file]] } {
+ if { $check_file_func eq "" || [eval [list $check_file_func $file]] } {
# If it's a file, add to our list. If it's a
# directory, add its contents to our list of files to
# examine next time.
Index: openacs-4/packages/acs-bootstrap-installer/tcl/20-db-bootstrap-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/tcl/20-db-bootstrap-procs.tcl,v
diff -u -r1.7 -r1.8
--- openacs-4/packages/acs-bootstrap-installer/tcl/20-db-bootstrap-procs.tcl 14 Apr 2005 17:33:38 -0000 1.7
+++ openacs-4/packages/acs-bootstrap-installer/tcl/20-db-bootstrap-procs.tcl 10 Jan 2007 21:22:03 -0000 1.8
@@ -14,7 +14,7 @@
@author Andrew Piskorski (atp@piskorski.com)
@creation-date 2003/03/16
} {
- if { [empty_string_p $dbn] } {
+ if { $dbn eq "" } {
set dbn [nsv_get {db_default_database} .]
}
return [nsv_get {db_available_pools} $dbn]
@@ -124,7 +124,7 @@
set old_availablepool_p 0
set default_dbn [lindex $database_names 0]
- if { [empty_string_p $default_dbn] } {
+ if { $default_dbn eq "" } {
set default_dbn {default}
set old_availablepool_p 1
@@ -155,7 +155,7 @@
set dbn_pools [list]
set the_set [ns_configsection $config_path]
- if { [string length $the_set] > 0 } {
+ if { $the_set ne "" } {
for {set i 0} {$i < [ns_set size $the_set]} {incr i} {
if { [string tolower [ns_set key $the_set $i]] == "availablepool" } {
lappend dbn_pools [ns_set value $the_set $i]
@@ -207,7 +207,7 @@
set bad_pools [list]
set long_error 0
foreach pool $pools {
- if { [catch { set db [ns_db gethandle -timeout 15 $pool]}] || ![string compare $db ""] } {
+ if { [catch { set db [ns_db gethandle -timeout 15 $pool]}] || $db eq "" } {
ns_log Warning "$proc_name: couldn't allocate a handle from database pool \"$pool\"."
lappend bad_pools "<li>OpenACS could not allocate a handle from database pool \"$pool\"."
set long_error 1
@@ -232,12 +232,12 @@
}
ns_db releasehandle $db
- if { [string length $this_suffix] == 0 } {
+ if { $this_suffix eq "" } {
ns_log Notice "$proc_name: couldn't determine RDBMS type of database pool \"$pool\"."
lappend bad_pools "<li>OpenACS could not determine the RDBMS type associated with
pool \"$pool\"."
set long_error 1
- } elseif { [string length [nsv_get ad_database_type .]] == 0 } {
+ } elseif { [nsv_get ad_database_type .] eq "" } {
nsv_set ad_database_type . $this_suffix
} elseif { ![string match $this_suffix [nsv_get ad_database_type .]] } {
ns_log Notice "$proc_name: Database pool \"$pool\" type \"$this_suffix\" differs from
@@ -249,7 +249,7 @@
}
}
- if { [string length [nsv_get ad_database_type .]] == 0 } {
+ if { [nsv_get ad_database_type .] eq "" } {
set database_problem "RDBMS type could not be determined for any pool."
ns_log Error "$proc_name: RDBMS type could not be determined for any pool."
}
Index: openacs-4/packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl,v
diff -u -r1.32 -r1.33
--- openacs-4/packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl 26 Jan 2004 15:39:42 -0000 1.32
+++ openacs-4/packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl 10 Jan 2007 21:22:03 -0000 1.33
@@ -85,7 +85,7 @@
set dirs_in_pageroot [llength [split [ns_info pageroot] "/"]] ;# See comments by RBM
# Fix to cope with both full and relative paths
- if { [string index $path 0] == "/"} {
+ if { [string index $path 0] eq "/"} {
set components_lesser [lrange $components $dirs_in_pageroot end]
} else {
set components_lesser $components
@@ -105,38 +105,38 @@
# was being recognized as a datamodel create script for the forums
# package.
- if { [string equal $extension ".sql"] } {
+ if {$extension eq ".sql"} {
if { [lsearch -glob $components "*upgrade-*-*"] >= 0 } {
set type "data_model_upgrade"
} elseif { [regexp -- "^$package_key-(create|drop)\.sql\$" [file tail $path] "" kind] } {
set type "data_model_$kind"
} else {
set type "data_model"
}
- } elseif { [string equal $extension ".dat"] } {
+ } elseif {$extension eq ".dat"} {
set type "sql_data"
- } elseif { [string equal $extension ".ctl"] } {
+ } elseif {$extension eq ".ctl"} {
set type "ctl_file"
- } elseif { [string equal $extension ".sqlj"] } {
+ } elseif {$extension eq ".sqlj"} {
set type "sqlj_code"
- } elseif { [string equal $extension ".info"] } {
+ } elseif {$extension eq ".info"} {
set type "package_spec"
- } elseif { [string equal $extension ".xql"] } {
+ } elseif {$extension eq ".xql"} {
set type "query_file"
- } elseif { [string equal $extension ".java"] } {
+ } elseif {$extension eq ".java"} {
set type "java_code"
- } elseif { [string equal $extension ".jar"] } {
+ } elseif {$extension eq ".jar"} {
set type "java_archive"
} elseif { [lsearch $components "doc"] >= 0 } {
set type "documentation"
- } elseif { [string equal $extension ".pl"] || \
- [string equal $extension ".sh"] || \
+ } elseif { $extension eq ".pl" || \
+ $extension eq ".sh" || \
[lsearch $components "bin"] >= 0 } {
set type "shell"
} elseif { [lsearch $components "templates"] >= 0 } {
set type "template"
} elseif { [llength $components] == 1 && \
- ([string equal $extension ".html"] || [string equal $extension ".adp"]) } {
+ ($extension eq ".html" || $extension eq ".adp") } {
# HTML or ADP file in the top level of a package - assume it's documentation.
set type "documentation"
@@ -147,10 +147,10 @@
set type "content_page"
} elseif { [lsearch $components_lesser "lib"] >= 0 } {
set type "include_page"
- } elseif { [string equal $extension ".tcl"] && [string equal [lindex $components_lesser 0] "tcl"] } {
+ } elseif { $extension eq ".tcl" && [string equal [lindex $components_lesser 0] "tcl"] } {
# A .tcl file residing under dir .../package_key/tcl/
if { [regexp -- {-(procs|init)(-[0-9a-zA-Z]*)?\.tcl$} [file tail $path] "" kind] } {
- if { [string equal [lindex $components end-1] test] } {
+ if {[lindex $components end-1] eq "test"} {
set type "test_$kind"
} else {
set type "tcl_$kind"
@@ -197,7 +197,7 @@
@see apm_guess_file_type
@see apm_guess_db_type
} {
- if { [empty_string_p $package_path] } {
+ if { $package_path eq "" } {
set package_path [acs_package_root_dir $package_key]
}
@@ -207,16 +207,16 @@
set matching_files [list]
foreach file $files {
- set rel_path [string range $file [expr [string length $package_path] + 1] end]
+ set rel_path [string range $file [expr {[string length $package_path] + 1}] end]
set file_type [apm_guess_file_type $package_key $rel_path]
set file_db_type [apm_guess_db_type $package_key $rel_path]
- set type_match_p [expr [empty_string_p $file_types] || [lsearch $file_types $file_type] != -1]
+ set type_match_p [expr {$file_types eq "" || [lsearch $file_types $file_type] != -1}]
if { $all_db_types_p } {
set db_match_p 1
} else {
- set db_match_p [expr [empty_string_p $file_db_type] || [string equal $file_db_type $system_db_type]]
+ set db_match_p [expr {$file_db_type eq "" || $file_db_type eq $system_db_type}]
}
if { $type_match_p && $db_match_p } {
@@ -275,7 +275,7 @@
} else {
# Parsing succeeded
set prefix $filename_info(prefix)
- if { [empty_string_p $prefix] } {
+ if { $prefix eq "" } {
# No prefix - this is considered a catalog file
set return_value 1
} else {
@@ -325,15 +325,15 @@
set file_type [apm_guess_file_type $package_key $path]
if { [string match "data_model*" $file_type] ||
- [string match "ctl_file" $file_type] } {
+ "ctl_file" eq $file_type } {
set sql_index [lsearch $components "sql"]
if { $sql_index >= 0 } {
- set db_dir [lindex $components [expr $sql_index + 1]]
- if { [string equal $db_dir "common"] } {
+ set db_dir [lindex $components [expr {$sql_index + 1}]]
+ if {$db_dir eq "common"} {
return ""
}
foreach known_database_type [db_known_database_types] {
- if { [string equal [lindex $known_database_type 0] $db_dir] } {
+ if {[lindex $known_database_type 0] eq $db_dir} {
return $db_dir
}
}
@@ -475,8 +475,8 @@
set file_db_type [apm_guess_db_type $package_key $file]
set file_type [apm_guess_file_type $package_key $file]
- if {[string equal $file_type query_file] &&
- ([empty_string_p $file_db_type] || [string equal $file_db_type $db_type])} {
+ if {$file_type eq "query_file" &&
+ ($file_db_type eq "" || $file_db_type eq $db_type)} {
db_qd_load_query_file $file
}
}
@@ -518,7 +518,7 @@
if { [apm_backup_file_p $tail] } {
return 1
}
- if { [string equal $tail "CVS"] } {
+ if {$tail eq "CVS"} {
return 1
}
return 0
@@ -545,5 +545,5 @@
Files for which apm_ignore_file_p returns true will be ignored.
Backup files are ignored.
} {
- return [expr ![apm_ignore_file_p $filename]]
+ return [expr {![apm_ignore_file_p $filename]}]
}
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.39 -r1.40
--- openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 13 Nov 2006 21:31:59 -0000 1.39
+++ openacs-4/packages/acs-bootstrap-installer/tcl/40-db-query-dispatcher-procs.tcl 10 Jan 2007 21:22:03 -0000 1.40
@@ -16,7 +16,7 @@
# The following code allows ad_proc to be used
# here (a local workalike is declared if absent).
# added 2002-09-11 Jeff Davis (davis@xarg.net)
-if {! [string equal {} [info procs ad_library]]} {
+if {{} ne [info procs ad_library] } {
ad_library {
Query Dispatching for multi-RDBMS capability
@@ -26,7 +26,7 @@
}
}
-if { ! [string equal {} [info procs ad_proc]] } {
+if { {} ne [info procs ad_proc] } {
set remove_ad_proc_p 0
} else {
set remove_ad_proc_p 1
@@ -46,7 +46,7 @@
set args [lrange $args $count end]
# args can be {docs body} {body} {docs -}
# make sure it is non empty and does not end in -
- if {[llength $args] && ![string equal [lindex $args end] "-"]} {
+ if {[llength $args] && [lindex $args end] ne "-" } {
proc $name $arglist [lindex $args end]
}
}
@@ -105,7 +105,7 @@
# the current RDBMS then we have compatibility. Otherwise we don't.
foreach t [split [db_rdbms_get_version $rdbms_test ] "\."] \
p [split [db_rdbms_get_version $rdbms_pattern] "\."] {
- if {$t != $p} {return [expr $t < $p]}
+ if {$t != $p} {return [expr {$t < $p}]}
}
# Same version (though not strictly "older") is OK
@@ -242,14 +242,14 @@
# We catch this in case we're being called from the top level
# (eg. from bootstrap.tcl), in which case we return what we
# were given
- if { [catch {string trimleft [info level [expr "-1 - $added_stack_num"]] ::} proc_name] } {
+ if { [catch {string trimleft [info level [expr {-1 - $added_stack_num}]] ::} proc_name] } {
return $local_name
}
# If util_memoize, we have to go back up one in the stack
- if {[lindex $proc_name 0] == "util_memoize"} {
+ if {[lindex $proc_name 0] eq "util_memoize"} {
# db_qd_log QDDebug "util_memoize! going up one level"
- set proc_name [info level [expr "-2 - $added_stack_num"]]
+ set proc_name [info level [expr {-2 - $added_stack_num}]]
}
set list_of_source_procs {ns_sourceproc apm_source template::adp_parse template::frm_page_handler rp_handle_tcl_request}
@@ -262,7 +262,7 @@
# TEST
# for {set i 0} {$i < 6} {incr i} {
- # if {[catch {db_qd_log QDDebug "LEVEL=$i= [info level [expr "-1 - $i"]]"} errmsg]} {}
+ # if {[catch {db_qd_log QDDebug "LEVEL=$i= [info level [expr {-1 - $i}]]"} errmsg]} {}
# }
# Check the ad_conn stuff
@@ -341,10 +341,10 @@
# proc_name, so that the correct query can be looked up.
# (Openacs - DanW)
- set calling_namespace [string range [uplevel [expr 1 + $added_stack_num] {namespace current}] 2 end]
+ set calling_namespace [string range [uplevel [expr {1 + $added_stack_num}] {namespace current}] 2 end]
# db_qd_log QDDebug "calling namespace = $calling_namespace"
- if {![string equal $calling_namespace ""] &&
+ if {$calling_namespace ne "" &&
![regexp {::} $proc_name all]} {
set proc_name ${calling_namespace}::${proc_name}
@@ -423,11 +423,11 @@
} {
set fullquery [db_qd_fetch $statement_name]
- if {![empty_string_p $fullquery]} {
+ if {$fullquery ne ""} {
set sql [db_fullquery_get_querytext $fullquery]
} else {
db_qd_log Debug "NO FULLQUERY FOR $statement_name --> using default SQL"
- if { [empty_string_p $sql] } {
+ if { $sql eq "" } {
# The default SQL is empty, that implies a bug somewhere in the code.
error "No fullquery for $statement_name and default SQL empty - query for statement missing"
}
@@ -512,7 +512,7 @@
# db_qd_log QDDebug "one parse result -$result-"
# If we get the empty string, we are done parsing
- if {$result == ""} {
+ if {$result eq ""} {
break
}
@@ -560,7 +560,7 @@
set fullquery_array [nsv_get OACS_FULLQUERIES $fullquery_name]
# If this isn't cached!
- if {$fullquery_array == ""} {
+ if {$fullquery_array eq ""} {
# we need to do something
return ""
}
@@ -666,7 +666,7 @@
set root_node [xml_doc_get_first_node $parsed_doc]
# Check that it's a queryset
- if {[xml_node_get_name $root_node] != "queryset"} {
+ if {[xml_node_get_name $root_node] ne "queryset"} {
# db_qd_log Error "OH OH, error, first node is [xml_node_get_name $root_node] and not 'queryset'"
return ""
}
@@ -739,7 +739,7 @@
# db_qd_log QDDebug "parsing one query node in XML with name -[xml_node_get_name $one_query_node]-"
# Check that this is a fullquery
- if {[xml_node_get_name $one_query_node] != "fullquery"} {
+ if {[xml_node_get_name $one_query_node] ne "fullquery"} {
return ""
}
@@ -767,7 +767,7 @@
Parse and RDBMS struct from an XML fragment node
} {
# Check that it's RDBMS
- if {[xml_node_get_name $rdbms_node] != "rdbms"} {
+ if {[xml_node_get_name $rdbms_node] ne "rdbms"} {
db_qd_log Debug "db_rdbms_parse_from_xml_node: PARSER = BAD RDBMS NODE!"
return {}
}
@@ -805,7 +805,7 @@
set root_path_length [string length $root_path]
# Check if the path starts with the root
- if {[string range $path 0 [expr "$root_path_length - 1"]] == $root_path} {
+ if {[string range $path 0 [expr {$root_path_length - 1}]] == $root_path} {
return 0
} else {
return 1
@@ -853,16 +853,16 @@
}
# append first chunk before the querytext including "<querytext>"
- append new_file_content [string range $rest_of_file_content 0 [expr "$first_querytext_open + $querytext_open_len - 1"]]
+ append new_file_content [string range $rest_of_file_content 0 [expr {$first_querytext_open + $querytext_open_len - 1}]]
# append quoted querytext
- append new_file_content [ns_quotehtml [string range $rest_of_file_content [expr "$first_querytext_open + $querytext_open_len"] [expr "$first_querytext_close - 1"]]]
+ append new_file_content [ns_quotehtml [string range $rest_of_file_content [expr {$first_querytext_open + $querytext_open_len}] [expr {$first_querytext_close - 1}]]]
# append close querytext
append new_file_content $querytext_close
# Set up the rest
- set rest_of_file_content [string range $rest_of_file_content [expr "$first_querytext_close + $querytext_close_len"] end]
+ set rest_of_file_content [string range $rest_of_file_content [expr {$first_querytext_close + $querytext_close_len}] end]
}
# db_qd_log QDDebug "new massaged file content: \n $new_file_content \n"
@@ -879,7 +879,7 @@
Centralized DB QD logging
If you want to debug the QD, change QDDebug below to Debug
} {
- if {![string equal "QDDebug" $level]} {
+ if {"QDDebug" ne $level } {
ns_log $level "$msg"
}
}
Index: openacs-4/packages/acs-content-repository/tcl/acs-content-repository-callback-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/acs-content-repository-callback-procs.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-content-repository/tcl/acs-content-repository-callback-procs.tcl 4 Jun 2006 00:45:23 -0000 1.2
+++ openacs-4/packages/acs-content-repository/tcl/acs-content-repository-callback-procs.tcl 10 Jan 2007 21:22:03 -0000 1.3
@@ -33,7 +33,7 @@
set package_key [apm_package_key_from_id $package_id]
- if {[string equal $package_key "acs-content-repository"] && [string equal "CRFileLocationRoot" $parameter] && ![empty_string_p $value]} {
+ if {$package_key eq "acs-content-repository" && "CRFileLocationRoot" eq $parameter && $value ne ""} {
nsv_unset CR_LOCATIONS CR_FILES
nsv_set CR_LOCATIONS CR_FILES "[file dirname [string trimright [ns_info tcllib] "/"]]/$value"
} else {
Index: openacs-4/packages/acs-content-repository/tcl/acs-content-repository-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/acs-content-repository-init.tcl,v
diff -u -r1.10 -r1.11
--- openacs-4/packages/acs-content-repository/tcl/acs-content-repository-init.tcl 4 Jun 2006 00:45:23 -0000 1.10
+++ openacs-4/packages/acs-content-repository/tcl/acs-content-repository-init.tcl 10 Jan 2007 21:22:03 -0000 1.11
@@ -28,7 +28,7 @@
set file_location [parameter::get_from_package_key -package_key "acs-content-repository" -parameter "CRFileLocationRoot" -default "content-repository-content-files"]
nsv_set CR_LOCATIONS . ""
-if ![nsv_exists CR_LOCATIONS CR_FILES] {
+if {![nsv_exists CR_LOCATIONS CR_FILES]} {
nsv_set CR_LOCATIONS CR_FILES "[file dirname [string trimright [ns_info tcllib] "/"]]/$file_location"
Index: openacs-4/packages/acs-content-repository/tcl/acs-content-repository-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/acs-content-repository-procs.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-content-repository/tcl/acs-content-repository-procs.tcl 28 Oct 2003 22:30:23 -0000 1.5
+++ openacs-4/packages/acs-content-repository/tcl/acs-content-repository-procs.tcl 10 Jan 2007 21:22:03 -0000 1.6
@@ -49,15 +49,15 @@
ad_proc -private cr_scan_mime_types {} {
# Get the config file ns_set
set mime_types [ns_configsection "ns/mimetypes"]
- if {![empty_string_p $mime_types]} {
+ if {$mime_types ne ""} {
set n_mime_types [ns_set size $mime_types]
for {set i 0} {$i < $n_mime_types} {incr i} {
set extension [ns_set key $mime_types $i]
set mime_type [ns_set value $mime_types $i]
# special case
- if {$extension == "NoExtension" || $extension == "Default"} {
+ if {$extension eq "NoExtension" || $extension eq "Default"} {
continue
}
Index: openacs-4/packages/acs-content-repository/tcl/content-folder-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/content-folder-procs.tcl,v
diff -u -r1.12 -r1.13
--- openacs-4/packages/acs-content-repository/tcl/content-folder-procs.tcl 15 Nov 2006 17:11:36 -0000 1.12
+++ openacs-4/packages/acs-content-repository/tcl/content-folder-procs.tcl 10 Jan 2007 21:22:03 -0000 1.13
@@ -73,7 +73,7 @@
# inherit the attributes of the parent folder
- if {![string eq $parent_id ""]} {
+ if {$parent_id ne "" } {
db_dml inherit_folder_type ""
@@ -198,13 +198,13 @@
# create local variable to use for binding
set $attribute $value
- if {![string equal "" $update_text]} {
+ if {$update_text ne ""} {
append update_text ","
}
append update_text " ${attribute} = :${attribute} "
}
}
- if {![string equal "" $update_text]} {
+ if {$update_text ne ""} {
# we have valid attributes, update them
Index: openacs-4/packages/acs-content-repository/tcl/content-item-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/content-item-procs.tcl,v
diff -u -r1.17 -r1.18
--- openacs-4/packages/acs-content-repository/tcl/content-item-procs.tcl 1 Nov 2006 20:08:33 -0000 1.17
+++ openacs-4/packages/acs-content-repository/tcl/content-item-procs.tcl 10 Jan 2007 21:22:03 -0000 1.18
@@ -72,14 +72,14 @@
@see content::symlink::new content::extlink::new content::folder::new
} {
- if {[empty_string_p $creation_user]} {
+ if {$creation_user eq ""} {
set creation_user [ad_conn user_id]
}
- if {[empty_string_p $creation_ip]} {
+ if {$creation_ip eq ""} {
set creation_ip [ad_conn peeraddr]
}
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
set package_id [ad_conn package_id]
}
@@ -225,11 +225,11 @@
error "content::item::get revision was '${revision}'. It must be 'live' or 'latest'"
}
set content_type [content_type -item_id $item_id]
- if {[string equal "" $content_type]} {
+ if {$content_type eq ""} {
# content_type query was unsucessful, item does not exist
return 0
}
- if {[string equal "content_folder" $content_type]} {
+ if {"content_folder" eq $content_type} {
return [db_0or1row get_item_folder "" -column_array local_array]
}
set table_name [db_string get_table_name "select table_name from acs_object_types where object_type=:content_type"]
@@ -271,13 +271,13 @@
# create local variable to use for binding
set $attribute $value
- if {![string equal "" $update_text]} {
+ if {$update_text ne ""} {
append update_text ","
}
append update_text " ${attribute} = :${attribute} "
}
}
- if {![string equal "" $update_text]} {
+ if {$update_text ne ""} {
# we have valid attributes, update them
@@ -746,7 +746,7 @@
} {
set filename [template::util::file::get_property filename $upload_file]
- if {$filename != "" } {
+ if {$filename ne "" } {
set tmp_filename [template::util::file::get_property tmp_filename $upload_file]
set mime_type [template::util::file::get_property mime_type $upload_file]
set tmp_size [file size $tmp_filename]
Index: openacs-4/packages/acs-content-repository/tcl/content-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/content-procs.tcl,v
diff -u -r1.10 -r1.11
--- openacs-4/packages/acs-content-repository/tcl/content-procs.tcl 22 Sep 2003 19:48:07 -0000 1.10
+++ openacs-4/packages/acs-content-repository/tcl/content-procs.tcl 10 Jan 2007 21:22:03 -0000 1.11
@@ -47,7 +47,7 @@
ns_mkdir [cr_fs_path]$path
}
- if {![string equal [string index $path end] "/"]} {
+ if {[string index $path end] ne "/" } {
append path "/"
}
Index: openacs-4/packages/acs-content-repository/tcl/content-revision-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/content-revision-procs.tcl,v
diff -u -r1.18 -r1.19
--- openacs-4/packages/acs-content-repository/tcl/content-revision-procs.tcl 15 Dec 2006 00:01:15 -0000 1.18
+++ openacs-4/packages/acs-content-repository/tcl/content-revision-procs.tcl 10 Jan 2007 21:22:03 -0000 1.19
@@ -113,8 +113,8 @@
# parameters to this procedure
foreach type_attribute $type_attributes {
- if {![string equal "cr_revisions" [lindex $type_attribute 1]] \
- && ![string equal "acs_objects" [lindex $type_attribute 1]]} {
+ if {"cr_revisions" ne [lindex $type_attribute 1] \
+ && "acs_objects" ne [lindex $type_attribute 1] } {
lappend valid_attributes [lindex $type_attribute 2]
}
}
Index: openacs-4/packages/acs-content-repository/tcl/content-type-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/content-type-procs.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-content-repository/tcl/content-type-procs.tcl 15 Nov 2006 06:17:51 -0000 1.9
+++ openacs-4/packages/acs-content-repository/tcl/content-type-procs.tcl 10 Jan 2007 21:22:03 -0000 1.10
@@ -92,7 +92,7 @@
@return attribute_id for created attribute
} {
- if {[db_type] == "oracle"} {
+ if {[db_type] eq "oracle"} {
switch -- $column_spec {
text { set column_spec clob }
boolean { set column_spec "char(1)" }
Index: openacs-4/packages/acs-content-repository/tcl/doc-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/doc-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-content-repository/tcl/doc-procs.tcl 27 Jul 2006 01:15:52 -0000 1.6
+++ openacs-4/packages/acs-content-repository/tcl/doc-procs.tcl 10 Jan 2007 21:22:03 -0000 1.7
@@ -23,7 +23,7 @@
regexp {[^@]*} $info_source comment
set info(comment) $comment
- if [regexp {@see (.*)} $info_source x see] {
+ if {[regexp {@see (.*)} $info_source x see]} {
foreach s [split $see ","] {
# strip braces
regsub {\{([^\}]+)\}} $s {\1} s
Index: openacs-4/packages/acs-content-repository/tcl/extlink-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/Attic/extlink-procs.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-content-repository/tcl/extlink-procs.tcl 27 Feb 2005 20:05:58 -0000 1.8
+++ openacs-4/packages/acs-content-repository/tcl/extlink-procs.tcl 10 Jan 2007 21:22:03 -0000 1.9
@@ -36,7 +36,7 @@
set creation_user [ad_conn user_id]
set creation_ip [ad_conn peeraddr]
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
set package_id [ad_conn package_id]
}
Index: openacs-4/packages/acs-content-repository/tcl/filter-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/filter-procs.tcl,v
diff -u -r1.28 -r1.29
--- openacs-4/packages/acs-content-repository/tcl/filter-procs.tcl 20 Apr 2005 20:11:14 -0000 1.28
+++ openacs-4/packages/acs-content-repository/tcl/filter-procs.tcl 10 Jan 2007 21:22:03 -0000 1.29
@@ -36,15 +36,15 @@
set template_root \
[ad_parameter -package_id $package_id TemplateRoot dummy ""]
- if { [empty_string_p $template_root] } {
+ if { $template_root eq "" } {
# Look for template root defined in the CR
set package_id [apm_package_id_from_key "acs-content-repository"]
set template_root [ad_parameter -package_id $package_id \
TemplateRoot dummy "templates"]
}
- if { [string index $template_root 0] != "/" } {
+ if { [string index $template_root 0] ne "/" } {
# Relative path, prepend server_root
set template_root "[acs_root_dir]/$template_root"
}
@@ -112,7 +112,7 @@
}
# Get the content type
- if { [empty_string_p $content_type] } {
+ if { $content_type eq "" } {
set content_type [db_string get_content_type ""]
}
@@ -208,13 +208,13 @@
-item_id $item_info(item_id)]
# No item found, so do not handle this request
- if { [string equal "" $item_info(item_id)] } {
+ if {$item_info(item_id) eq ""} {
set item_info(item_id) [::content::item::get_id -item_path $url \
-root_folder_id $content_root \
-resolve_index $resolve_index]
set item_info(content_type) [::content::item::get_content_type \
-item_id $item_info(item_id)]
- if { [string equal "" $item_info(item_id)] } {
+ if {$item_info(item_id) eq ""} {
ns_log notice "content::init: no content found for url $url"
return 0
}
@@ -224,22 +224,22 @@
set item_url $url
set item_id $item_info(item_id)
- if { [empty_string_p $content_type] } {
+ if { $content_type eq "" } {
set content_type $item_info(content_type)
}
# TODO accept latest revision as well. DaveB
# Make sure that a live revision exists
- if { [empty_string_p $rev_id] } {
- if {[string equal "best" $revision]} {
+ if { $rev_id eq "" } {
+ if {"best" eq $revision} {
# lastest_revision unless live_revision is set, then live_revision
set revision_id [::item::get_best_revision $item_id]
} else {
# default live_revision
set revision_id [::item::get_live_revision $item_id]
}
- if { [string equal "" $revision_id] } {
+ if {$revision_id eq ""} {
ns_log notice "content::init: no live revision found for content item $item_id"
return 0
}
@@ -253,7 +253,7 @@
# Get the template
set template_found_p [db_0or1row get_template_url "" -column_array info]
- if { !$template_found_p || [string equal $info(template_url) {}] } {
+ if { !$template_found_p || $info(template_url) eq {} } {
ns_log notice "content::init: No template found to render content item $item_id in context '$context'"
return 0
}
Index: openacs-4/packages/acs-content-repository/tcl/item-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/Attic/item-procs.tcl,v
diff -u -r1.21 -r1.22
--- openacs-4/packages/acs-content-repository/tcl/item-procs.tcl 25 Apr 2005 22:50:38 -0000 1.21
+++ openacs-4/packages/acs-content-repository/tcl/item-procs.tcl 10 Jan 2007 21:22:03 -0000 1.22
@@ -82,7 +82,7 @@
} {
set is_publishable [db_string ip_is_publishable_p ""]
- return [string equal $is_publishable t]
+ return [string equal $is_publishable "t"]
}
@@ -180,7 +180,7 @@
set types [db_list cmbt_get_content_mime_types ""]
- set need_text [expr [llength $types] > 0]
+ set need_text [expr {[llength $types] > 0}]
if { [info exists opts(get_labels)] } {
set methods [list \
@@ -268,7 +268,7 @@
# Strip off file extension
set last [string last "." $url]
if { $last > 0 } {
- set url [string range $url 0 [expr $last - 1]]
+ set url [string range $url 0 [expr {$last - 1}]]
}
if { ![template::util::is_nil root_folder] } {
@@ -665,16 +665,16 @@
} {
upvar 1 $array content
- if { [empty_string_p $item_id] } {
+ if { $item_id eq "" } {
set item_id [get_item_from_revision $revision_id]
- if { [empty_string_p $item_id] } {
+ if { $item_id eq "" } {
ns_log notice "item::get_content: no such revision: $reivision_id"
return 0
}
- } elseif { [empty_string_p $revision_id] } {
+ } elseif { $revision_id eq "" } {
set revision_id [item::get_live_revision $item_id]
}
- if { [empty_string_p $revision_id] } {
+ if { $revision_id eq "" } {
error "You must supply revision_id, or the item must have a live revision."
}
@@ -706,7 +706,7 @@
@author Peter Marklund
} {
- if { [empty_string_p $revision_id] } {
+ if { $revision_id eq "" } {
set revision_id [item::get_element -item_id $item_id -element latest_revision]
}
Index: openacs-4/packages/acs-content-repository/tcl/keyword-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/Attic/keyword-procs.tcl,v
diff -u -r1.10 -r1.11
--- openacs-4/packages/acs-content-repository/tcl/keyword-procs.tcl 20 Mar 2005 00:53:52 -0000 1.10
+++ openacs-4/packages/acs-content-repository/tcl/keyword-procs.tcl 10 Jan 2007 21:22:03 -0000 1.11
@@ -24,7 +24,7 @@
set user_id [ad_conn user_id]
set creation_ip [ad_conn peeraddr]
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
set package_id [ad_conn package_id]
}
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.6 -r1.7
--- openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl 3 Nov 2003 12:45:23 -0000 1.6
+++ openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl 10 Jan 2007 21:22:03 -0000 1.7
@@ -26,7 +26,7 @@
-package_id [ad_conn package_id] \
-parameter PageRoot]
- if { [string index $root_path 0] != "/" } {
+ if { [string index $root_path 0] ne "/" } {
# Relative path, prepend server_root
set root_path "[ns_info pageroot]/$root_path"
}
@@ -62,7 +62,7 @@
set page_root [publish::get_page_root]
set absolute_paths [list]
foreach path $root_paths {
- if { [string index $path 0] != "/" } {
+ if { [string index $path 0] ne "/" } {
lappend absolute_paths [ns_normalizepath "$page_root/$path"]
} else {
lappend absolute_paths $path
@@ -79,7 +79,7 @@
} {
set index [string last "/" $path]
if { $index != -1 } {
- file mkdir [string range $path 0 [expr $index - 1]]
+ file mkdir [string range $path 0 [expr {$index - 1}]]
}
}
@@ -457,7 +457,7 @@
# Get the template
set ::content::template_url [item::get_template_url $item_id]
- if { [string equal $::content::template_url {}] } {
+ if {$::content::template_url eq {}} {
ns_log Warning "publish::merge_with_template: no template for item $item_id"
return ""
}
@@ -812,13 +812,13 @@
} {
# Get the child item
- if { [string equal $relation_type child] } {
+ if {$relation_type eq "child"} {
set subitems [db_list rs_get_subitems ""]
} else {
set subitems [db_list cs_get_subitems_related ""]
}
- set sub_item_id [lindex $subitems [expr $index - 1]]
+ set sub_item_id [lindex $subitems [expr {$index - 1}]]
if { [template::util::is_nil sub_item_id] } {
ns_log notice "publish::render_subitem: No such subitem"
@@ -828,7 +828,7 @@
# Call the appropriate handler function
set code [list handle_item $sub_item_id -html $extra_args]
- if { [string equal $is_embed t] } {
+ if {$is_embed eq "t"} {
lappend code -embed
}
Index: openacs-4/packages/acs-content-repository/tcl/revision-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/revision-procs.tcl,v
diff -u -r1.24 -r1.25
--- openacs-4/packages/acs-content-repository/tcl/revision-procs.tcl 31 Dec 2006 21:08:26 -0000 1.24
+++ openacs-4/packages/acs-content-repository/tcl/revision-procs.tcl 10 Jan 2007 21:22:03 -0000 1.25
@@ -45,15 +45,15 @@
ad_return -code error "Either revision_id or item_id must be specified"
}
- if { ![string equal $storage_type "file"] && \
- ![string equal $storage_type "text"] && \
- ![string equal $storage_type "lob"] } {
+ if { $storage_type ne "file" && \
+ $storage_type ne "text" && \
+ $storage_type ne "lob" } {
ad_return -code error "Storage type '$storage_type' is invalid."
}
# I set content length to 0 here because otherwise I need to do
# db-specific queries for get_revision_info
- if {[empty_string_p $content_length]} {
+ if {$content_length eq ""} {
set content_length 0
}
@@ -69,7 +69,7 @@
file {
set path [cr_fs_path $storage_area_key]
set filename [db_string write_file_content ""]
- if {[empty_string_p $filename]} {
+ if {$filename eq ""} {
ad_return -code error "No content for the revision $revision_id. This seems to be an error which occured during the upload of the file"
} else {
if { $string_p } {
@@ -181,15 +181,15 @@
# DRB: Eventually we should allow for text storage ... (CLOB for Oracle)
- if { ![string equal $storage_type "file"] && ![string equal $storage_type "lob"] } {
+ if { $storage_type ne "file" && $storage_type ne "lob" } {
return -code error "Imported content must be stored in the file system or as a large object"
}
- if {[string equal $mime_type "*/*"]} {
+ if {$mime_type eq "*/*"} {
set mime_type "application/octet-stream"
}
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
set package_id [ad_conn package_id]
}
@@ -199,7 +199,7 @@
}
# use content_type of existing item
- if $old_item_p {
+ if {$old_item_p} {
set content_type [db_string get_content_type ""]
} else {
# all we really need to know is if the mime type is mapped to image, we
@@ -222,16 +222,16 @@
switch $content_type {
image {
- if { [db_string image_subclass ""] == "f" } {
+ if { [db_string image_subclass ""] eq "f" } {
ad_return -code error "Image file must be stored in an image object"
}
set what_aolserver_told_us ""
- if { [string equal $mime_type "image/jpeg"] } {
+ if {$mime_type eq "image/jpeg"} {
catch { set what_aolserver_told_us [ns_jpegsize $tmp_filename] }
- } elseif { [string equal $mime_type "image/gif"] } {
+ } elseif {$mime_type eq "image/gif"} {
catch { set what_aolserver_told_us [ns_gifsize $tmp_filename] }
- } elseif { [string equal $mime_type "image/png"] } {
+ } elseif {$mime_type eq "image/png"} {
# we don't have built in png size detection
# but we want to allow upload of png images
} else {
@@ -240,7 +240,7 @@
# the AOLserver jpegsize command has some bugs where the height comes
# through as 1 or 2
- if { ![empty_string_p $what_aolserver_told_us] && \
+ if { $what_aolserver_told_us ne "" && \
[lindex $what_aolserver_told_us 0] > 10 && \
[lindex $what_aolserver_told_us 1] > 10 } {
set original_width [lindex $what_aolserver_told_us 0]
@@ -264,7 +264,7 @@
ad_return -code error "The file you uploaded was not an image (.gif, .jpg or .jpeg) file"
}
- if { [db_string content_revision_subclass ""] == "f" } {
+ if { [db_string content_revision_subclass ""] eq "f" } {
ad_return -code error "Content must be stored in a content revision object"
}
@@ -313,7 +313,7 @@
needed for its private type. This is a hack. Executing this SQL can't be done
within cr_import_content because the caller can't see the new revision's key...
} {
- if { [cr_registered_type_for_mime_type $mime_type] == "image" } {
+ if { [cr_registered_type_for_mime_type $mime_type] eq "image" } {
if { [info exists image_sql] } {
uplevel 1 [list db_dml dynamic_query $image_sql]
}
@@ -353,7 +353,7 @@
} {
set extension [string tolower [string trimleft [file extension $filename] "."]]
- if {[empty_string_p $extension]} {
+ if {$extension eq ""} {
return "*/*"
}
@@ -362,7 +362,7 @@
} else {
set mime_type [string tolower [ns_guesstype $filename]]
ns_log Debug "guessed mime \"$mime_type\" create_p $create_p"
- if {(!$create_p) || [string equal $mime_type "*/*"] || [empty_string_p $mime_type]} {
+ if {(!$create_p) || $mime_type eq "*/*" || $mime_type eq ""} {
# we don't have anything meaningful for this mimetype
# so just */* it.
Index: openacs-4/packages/acs-content-repository/tcl/symlink-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/Attic/symlink-procs.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-content-repository/tcl/symlink-procs.tcl 7 Dec 2004 08:32:13 -0000 1.5
+++ openacs-4/packages/acs-content-repository/tcl/symlink-procs.tcl 10 Jan 2007 21:22:03 -0000 1.6
@@ -34,7 +34,7 @@
set creation_user [ad_conn user_id]
set creation_ip [ad_conn peeraddr]
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
set package_id [ad_conn package_id]
}
Index: openacs-4/packages/acs-content-repository/tcl/test/content-image-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/test/content-image-test-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-content-repository/tcl/test/content-image-test-procs.tcl 6 Aug 2006 19:43:05 -0000 1.3
+++ openacs-4/packages/acs-content-repository/tcl/test/content-image-test-procs.tcl 10 Jan 2007 21:22:03 -0000 1.4
@@ -20,7 +20,7 @@
set returned_first_folder_id [content::folder::new \
-folder_id $first_folder_id \
-name "test_folder_${first_folder_id}"]
- aa_true "Folder created" [expr $first_folder_id == $returned_first_folder_id]
+ aa_true "Folder created" [expr {$first_folder_id == $returned_first_folder_id}]
content::folder::register_content_type \
-folder_id $first_folder_id \
@@ -35,7 +35,7 @@
-content_type "image" \
-storage_type "file"]
- aa_true "First item created $first_item_id" [expr $first_item_id == $returned_first_item_id]
+ aa_true "First item created $first_item_id" [expr {$first_item_id == $returned_first_item_id}]
# create an image
set image_id [db_nextval "acs_object_id_seq"]
@@ -45,7 +45,7 @@
-item_id $first_item_id \
-title "Test Title" \
-description "Test Description"]
- aa_true "Basic Image created revision_id $image_id returned_revision_id $returned_image_id " [expr $image_id == $returned_image_id]
+ aa_true "Basic Image created revision_id $image_id returned_revision_id $returned_image_id " [expr {$image_id == $returned_image_id}]
::item::get_content -revision_id $returned_image_id -array revision_content
aa_true "Revision contains correct content" [expr \
@@ -74,7 +74,7 @@
set returned_first_folder_id [content::folder::new \
-folder_id $first_folder_id \
-name "test_folder_${first_folder_id}"]
- aa_true "Folder created" [expr $first_folder_id == $returned_first_folder_id]
+ aa_true "Folder created" [expr {$first_folder_id == $returned_first_folder_id}]
content::folder::register_content_type \
-folder_id $first_folder_id \
Index: openacs-4/packages/acs-content-repository/tcl/test/content-item-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/test/content-item-test-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-content-repository/tcl/test/content-item-test-procs.tcl 4 Jun 2006 00:45:23 -0000 1.6
+++ openacs-4/packages/acs-content-repository/tcl/test/content-item-test-procs.tcl 10 Jan 2007 21:22:03 -0000 1.7
@@ -30,7 +30,7 @@
-folder_id $first_folder_id \
-content_type "content_revision"
- aa_true "Folder created" [expr $first_folder_id == $returned_first_folder_id]
+ aa_true "Folder created" [expr {$first_folder_id == $returned_first_folder_id}]
set is_empty [content::folder::is_empty -folder_id $first_folder_id]
aa_true "Folder is empty" [string is true $is_empty]
@@ -43,7 +43,7 @@
set returned_second_folder_id [content::folder::new \
-folder_id $second_folder_id \
-name "test_folder_${second_folder_id}"]
- aa_true "Folder 2 created" [expr $second_folder_id == $returned_second_folder_id]
+ aa_true "Folder 2 created" [expr {$second_folder_id == $returned_second_folder_id}]
#########################################################
@@ -59,9 +59,9 @@
-attributes [list [list title "$test_name"]]
]
- aa_true "First item created" [expr $first_item_id == $returned_first_item_id]
+ aa_true "First item created" [expr {$first_item_id == $returned_first_item_id}]
- aa_true "first item exists" [expr [content::item::get -item_id $first_item_id] == 1]
+ aa_true "first item exists" [expr {[content::item::get -item_id $first_item_id] == 1}]
aa_true "First item's revision exists" \
[expr \
@@ -87,7 +87,7 @@
-attributes [list [list title "${evil_test_name}"]]
]
- aa_true "Evil_name item created" [expr $evil_item_id == $returned_evil_item_id]
+ aa_true "Evil_name item created" [expr {$evil_item_id == $returned_evil_item_id}]
aa_true "Evil_name item exists" [expr \
[content::item::get \
@@ -96,7 +96,7 @@
-array_name evil_name] == 1]
aa_true "Evil_name item's revision exists" \
[expr \
- {![string equal "" $evil_name(latest_revision)]}]
+ {$evil_name(latest_revision) ne ""}]
#########################################################
# delete the evil_name item
@@ -165,11 +165,11 @@
# check that the item exists
#########################################################
- aa_true "New Type item created" [expr $new_type_item_id == $returned_new_type_item_id]
- aa_true "New Type item exists" [expr [content::item::get \
+ aa_true "New Type item created" [expr {$new_type_item_id == $returned_new_type_item_id}]
+ aa_true "New Type item exists" [expr {[content::item::get \
-item_id $new_type_item_id \
-revision "latest" \
- -array_name new_type_item] == 1]
+ -array_name new_type_item] == 1}]
#########################################################
# check that extended attribute exists
Index: openacs-4/packages/acs-content-repository/tcl/test/content-keyword-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/test/content-keyword-test-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-content-repository/tcl/test/content-keyword-test-procs.tcl 20 Mar 2005 13:41:50 -0000 1.1
+++ openacs-4/packages/acs-content-repository/tcl/test/content-keyword-test-procs.tcl 10 Jan 2007 21:22:03 -0000 1.2
@@ -26,7 +26,7 @@
# check that keyword_id, heading, description
# are set correctly
aa_true "Keyword_id assigned" \
- [expr $assigned_keyword_id == $keyword_id]
+ [expr {$assigned_keyword_id == $keyword_id}]
aa_true "Keyword heading set" \
[string equal "--test_keyword" [content::keyword::get_heading -keyword_id $keyword_id]]
aa_true "Keyword description set" \
Index: openacs-4/packages/acs-content-repository/tcl/test/content-revision-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/test/content-revision-test-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-content-repository/tcl/test/content-revision-test-procs.tcl 14 Feb 2005 18:17:32 -0000 1.4
+++ openacs-4/packages/acs-content-repository/tcl/test/content-revision-test-procs.tcl 10 Jan 2007 21:22:03 -0000 1.5
@@ -21,7 +21,7 @@
set returned_first_folder_id [content::folder::new \
-folder_id $first_folder_id \
-name "test_folder_${first_folder_id}"]
- aa_true "Folder created" [expr $first_folder_id == $returned_first_folder_id]
+ aa_true "Folder created" [expr {$first_folder_id == $returned_first_folder_id}]
content::folder::register_content_type \
-folder_id $first_folder_id \
@@ -35,7 +35,7 @@
-parent_id $first_folder_id \
-storage_type "text"]
- aa_true "First item created $first_item_id" [expr $first_item_id == $returned_first_item_id]
+ aa_true "First item created $first_item_id" [expr {$first_item_id == $returned_first_item_id}]
# create a revision
set revision_id [db_nextval "acs_object_id_seq"]
@@ -46,14 +46,14 @@
-title "Test Title" \
-description "Test Description" \
-content "Test Content"]
- aa_true "Basic Revision created revision_id $revision_id returned_revision_id $returned_revision_id " [expr $revision_id == $returned_revision_id]
+ aa_true "Basic Revision created revision_id $revision_id returned_revision_id $returned_revision_id " [expr {$revision_id == $returned_revision_id}]
::item::get_content -revision_id $returned_revision_id -array revision_content
set revision_content(content) [cr_write_content -revision_id $returned_revision_id -string]
- aa_true "Revision contains correct content" [expr \
- [string equal $revision_content(title) "Test Title"] \
- && [string equal $revision_content(content) "Test Content"] \
- && $revision_id == $revision_content(revision_id)]
+ aa_true "Revision contains correct content" [expr {
+ $revision_content(title) eq "Test Title"
+ && $revision_content(content) eq "Test Content"
+ && $revision_id == $revision_content(revision_id)}]
content::item::delete -item_id $first_item_id
Index: openacs-4/packages/acs-core-docs/www/files/tutorial/myfirstpackage-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-core-docs/www/files/tutorial/myfirstpackage-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-core-docs/www/files/tutorial/myfirstpackage-procs.tcl 21 Apr 2004 09:49:45 -0000 1.4
+++ openacs-4/packages/acs-core-docs/www/files/tutorial/myfirstpackage-procs.tcl 10 Jan 2007 21:22:03 -0000 1.5
@@ -22,7 +22,7 @@
mfp::note::delete -item_id $new_id
set get_again [catch {mfp::note::get -item_id $new_id -array note_array}]
- aa_false "After deleting a note, retrieving it fails" [expr $get_again == 0]
+ aa_false "After deleting a note, retrieving it fails" [expr {$get_again == 0}]
}
}
@@ -47,7 +47,7 @@
mfp::note::delete -item_id $new_id
set get_again [catch {mfp::note::get -item_id $new_id -array note_array}]
- aa_false "After deleting a note, retrieving it fails" [expr $get_again == 0]
+ aa_false "After deleting a note, retrieving it fails" [expr {$get_again == 0}]
}
}
Index: openacs-4/packages/acs-core-docs/www/sql/display-sql.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-core-docs/www/sql/display-sql.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-core-docs/www/sql/display-sql.tcl 11 Dec 2003 21:39:48 -0000 1.4
+++ openacs-4/packages/acs-core-docs/www/sql/display-sql.tcl 10 Jan 2007 21:22:03 -0000 1.5
@@ -40,7 +40,7 @@
}
-if {[empty_string_p $db]} {
+if {$db eq ""} {
# if we were not passed a DB string get a list of matching files.
@@ -50,7 +50,7 @@
regexp {([^/]*)/([^/]*)$} $f match db url
append text "<li> <a href=\"display-sql?[export_url_vars db url package_key]\">$db</a></li>"
}
- if {[empty_string_p $files]} {
+ if {$files eq ""} {
append text "<li> No sql file found."
}
append text {</ul>}
@@ -60,7 +60,7 @@
# we have a db.
- if {[string equal $db sql]} {
+ if {$db eq "sql"} {
set files [glob -nocomplain "[acs_package_root_dir $package_key]/sql/$url"]
} else {
set files [glob -nocomplain "[acs_package_root_dir $package_key]/sql/$db/$url"]
Index: openacs-4/packages/acs-lang/lib/messages-to-translate.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/lib/messages-to-translate.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-lang/lib/messages-to-translate.tcl 23 Oct 2003 09:56:41 -0000 1.6
+++ openacs-4/packages/acs-lang/lib/messages-to-translate.tcl 10 Jan 2007 21:22:03 -0000 1.7
@@ -1,6 +1,6 @@
set locale [ad_conn locale]
-set display_p [expr [lang::util::translator_mode_p] && ![string equal [ad_conn locale] "en_US"]]
+set display_p [expr {[lang::util::translator_mode_p] && [ad_conn locale] ne "en_US" }]
template::list::create \
-name messages \
Index: openacs-4/packages/acs-lang/tcl/lang-catalog-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/lang-catalog-procs.tcl,v
diff -u -r1.41 -r1.42
--- openacs-4/packages/acs-lang/tcl/lang-catalog-procs.tcl 4 Jun 2006 00:45:39 -0000 1.41
+++ openacs-4/packages/acs-lang/tcl/lang-catalog-procs.tcl 10 Jan 2007 21:22:04 -0000 1.42
@@ -66,7 +66,7 @@
} {
set value [xml_node_get_attribute $element $attribute]
- if { [empty_string_p $value] } {
+ if { $value eq "" } {
error "Required attribute \"$attribute\" missing from <[xml_node_get_name $element]>"
}
@@ -172,7 +172,7 @@
} {
set catalog_dir [package_catalog_dir $package_key]
- if { ![empty_string_p $charset] } {
+ if { $charset ne "" } {
set file_charset $charset
} else {
# We had problems storing digits in ISO-8859-6 so we decided
@@ -185,7 +185,7 @@
}
set message_backup_prefix ""
- if { ![empty_string_p $backup_from_version] } {
+ if { $backup_from_version ne "" } {
set message_backup_prefix "[message_backup_file_prefix]${backup_from_version}-${backup_to_version}_"
}
@@ -344,7 +344,7 @@
# Parse locale from filename
array set old_filename_info [apm_parse_catalog_path $old_catalog_file]
- if { [string equal $old_filename_info(locale) $filename_info(locale)] } {
+ if {$old_filename_info(locale) eq $filename_info(locale)} {
file delete $old_catalog_file
}
}
@@ -365,7 +365,7 @@
set message_count "0"
foreach message_key $message_key_list {
puts $catalog_file_id " <msg key=\"[ad_quotehtml $message_key]\">[ad_quotehtml $messages_array($message_key)]</msg>"
- if { [exists_and_not_null descriptions_array($message_key)] && $filename_info(locale) == "en_US" } {
+ if { [exists_and_not_null descriptions_array($message_key)] && $filename_info(locale) eq "en_US" } {
puts $catalog_file_id " <description key=\"[ad_quotehtml $message_key]\">[ad_quotehtml $descriptions_array($message_key)]</description>\n"
}
incr message_count
@@ -391,15 +391,15 @@
@author Peter Marklund
} {
- if { ![empty_string_p $package_key] } {
+ if { $package_key ne "" } {
set package_key_list $package_key
} else {
set package_key_list [apm_enabled_packages]
}
foreach package_key $package_key_list {
# We do not want to export acs-translations. This usually is a very bad idea as the object_ids are different from site to site.
- if {![string eq $package_key "acs-translations"]} {
+ if {$package_key ne "acs-translations" } {
# Loop over all locales that the package has messages in
# and write a catalog file for each such locale
db_foreach get_locales_for_package {} {
@@ -484,7 +484,7 @@
} {
# Check arguments
- if { [empty_string_p $catalog_file_contents] } {
+ if { $catalog_file_contents eq "" } {
error "lang::catalog::parse the catalog_file_contents arguments is the empty string"
}
@@ -589,7 +589,7 @@
set charset $filename_info(charset)
# Compare xml package_key with file path package_key - abort if there is a mismatch
- if { ![string equal $package_key $catalog_array(package_key)] } {
+ if { $package_key ne $catalog_array(package_key) } {
error "the package_key $catalog_array(package_key) in the file $file_path does not match the package_key $package_key in the filesystem"
}
@@ -770,7 +770,7 @@
if { [info exists db_messages($message_key)] } {
# db message exists
- if { ![string equal $db_messages($message_key) $base_messages($message_key)] } {
+ if { $db_messages($message_key) ne $base_messages($message_key) } {
# db message and base message differ
set db_change "update"
}
@@ -781,7 +781,7 @@
if { [info exists file_messages($message_key)] } {
# file message exists
- if { ![string equal $file_messages($message_key) $base_messages($message_key)] } {
+ if { $file_messages($message_key) ne $base_messages($message_key) } {
# file message and base message differ
set file_change "update"
}
@@ -843,7 +843,7 @@
switch $file_change {
none {}
add {
- if { ![string equal $db_messages($message_key) $file_messages($message_key)] } {
+ if { $db_messages($message_key) ne $file_messages($message_key) } {
# case 8
set import_case 8
# differing additions in db and file
@@ -857,7 +857,7 @@
switch $file_change {
none {}
update {
- if { ![string equal $db_messages($message_key) $file_messages($message_key)] } {
+ if { $db_messages($message_key) ne $file_messages($message_key) } {
# case 14
set import_case 14
# differing updates in file and db
@@ -902,7 +902,7 @@
###########################################
# For certain messages we need to move the sync point so that we have a current base for the next upgrade.
- if { [string equal $db_change "none"] || ![string equal $file_change "none"] } {
+ if { $db_change eq "none" || $file_change ne "none" } {
# If there is no db change then any change in the file will be reflected in
# db (file takes precedence) and file and db are identical.
# Also, regardless of what's happened in db, if
@@ -915,7 +915,7 @@
# Store a new message in the database if we are adding or updating
set error_p 0
- if { [string equal $upgrade_status "added"] || [string equal $upgrade_status "updated"] } {
+ if { $upgrade_status eq "added" || $upgrade_status eq "updated" } {
ns_log Debug "lang::catalog::import_messages - invoking lang::message::register with import_case=\"$import_case\" -update_sync=$update_sync_p $message_key $upgrade_status $conflict_p"
if { [catch {lang::message::register \
@@ -930,13 +930,13 @@
lappend message_count(errors) $errmsg
set error_p 1
}
- } elseif { $update_sync_p || [string equal $upgrade_status "deleted"] } {
+ } elseif { $update_sync_p || $upgrade_status eq "deleted" } {
# Set the upgrade_status, deleted_p, conflict_p, and sync_time properties of the message
# If we are doing nothing, the only property of the message we might want to update in the db
# is the sync_time as we might have discovered that db and file are in sync
array unset edit_array
- if { ![string equal $upgrade_status "no_upgrade"] } {
+ if { $upgrade_status ne "no_upgrade" } {
set edit_array(upgrade_status) $upgrade_status
set edit_array(deleted_p) [string equal $upgrade_status "deleted"]
set edit_array(conflict_p) $conflict_p
@@ -999,7 +999,7 @@
set message_count(deleted) 0
set message_count(errors) [list]
- if { ![empty_string_p $package_key] } {
+ if { $package_key ne "" } {
set package_key_list $package_key
} else {
set package_key_list [apm_enabled_packages]
@@ -1025,7 +1025,7 @@
-locales $locales]
# Issue a warning and exit if there are no catalog files
- if { [empty_string_p $catalog_files] } {
+ if { $catalog_files eq "" } {
ns_log Warning "No catalog files found for package $package_key"
continue
}
@@ -1039,8 +1039,8 @@
ns_log Error "The import of file $file_path failed, error message is:\n\n${errMsg}\n\nstack trace:\n\n$errorInfo\n\n"
} else {
foreach action [array names loop_message_count] {
- if { ![string equal $action "errors"] } {
- set message_count($action) [expr $message_count($action) + $loop_message_count($action)]
+ if { $action ne "errors" } {
+ set message_count($action) [expr {$message_count($action) + $loop_message_count($action)}]
}
}
set message_count(errors) [concat $message_count(errors) $loop_message_count(errors)]
Index: openacs-4/packages/acs-lang/tcl/lang-message-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/lang-message-procs.tcl,v
diff -u -r1.47 -r1.48
--- openacs-4/packages/acs-lang/tcl/lang-message-procs.tcl 1 Nov 2006 19:47:55 -0000 1.47
+++ openacs-4/packages/acs-lang/tcl/lang-message-procs.tcl 10 Jan 2007 21:22:04 -0000 1.48
@@ -86,7 +86,7 @@
set key_exists_p [db_string message_key_exists_p {}]
if { ! $key_exists_p } {
- if { [string equal $locale "en_US"] } {
+ if {$locale eq "en_US"} {
db_dml insert_message_key {}
} else {
# Non-default locale
@@ -103,7 +103,7 @@
# Exclude the special case of datetime configuration messages in acs-lang. An alternative
# to treating those messages as a special case here would be to have those messages use
# quoted percentage signs (double percentage signs).
- if { ![string equal $locale "en_US"] && ![regexp {^acs-lang\.localization-} $key] } {
+ if { $locale ne "en_US" && ![regexp {^acs-lang\.localization-} $key] } {
set embedded_vars [get_embedded_vars $message]
set embedded_vars_en_us [get_embedded_vars [lang::message::lookup en_US $key {} {} 0]]
set missing_vars [util_get_subset_missing $embedded_vars $embedded_vars_en_us]
@@ -423,7 +423,7 @@
$old_message_array(upgrade_status)
# If we are deleting an en_US message we need to mark the message deleted in all locales
- if { [string equal $locale "en_US"] } {
+ if {$locale eq "en_US"} {
set message_locales [db_list all_message_locales {
select locale
from lang_messages
@@ -537,7 +537,7 @@
while { [regexp [embedded_vars_regexp] $remaining_message \
match before_percent percent_match remaining_message] } {
- if { [string equal $percent_match "%%"] } {
+ if {$percent_match eq "%%"} {
# A quoted percentage sign - ignore
continue
} else {
@@ -579,7 +579,7 @@
append formated_message $before_percent
- if { [string equal $percent_match "%%"] } {
+ if {$percent_match eq "%%"} {
# A quoted percent sign
append formated_message "%"
} else {
@@ -715,7 +715,7 @@
# Make sure messages are in the cache
cache
- if { [empty_string_p $locale] } {
+ if { $locale eq "" } {
# No locale provided
if { [ad_conn isconnected] } {
@@ -728,7 +728,7 @@
} elseif { [string length $locale] == 2 } {
# Only language provided, let's get the default locale for this language
set default_locale [lang::util::default_locale_from_lang $locale]
- if { [empty_string_p $default_locale] } {
+ if { $default_locale eq "" } {
error "Could not look up locale for language $locale"
} else {
set locale $default_locale
@@ -764,7 +764,7 @@
if { [message_exists_p $locale $key] } {
set message [nsv_get lang_message_$locale $key]
} else {
- if {[string match acs-translations.* $key]} {
+ if {[string match "acs-translations.*" $key]} {
ns_log Debug "lang::message::lookup: Key '$key' does not exist in en_US"
set message "MESSAGE KEY MISSING: '$key'"
} else {
@@ -780,7 +780,7 @@
# Do any variable substitutions (interpolation of variables)
# Set upvar_level to 0 and substitution_list empty to prevent substitution from happening
if { [llength $substitution_list] > 0 || ($upvar_level >= 1 && [string first "%" $message] != -1) } {
- set message [lang::message::format $message $substitution_list [expr $upvar_level + 1]]
+ set message [lang::message::format $message $substitution_list [expr {$upvar_level + 1}]]
}
if { [lang::util::translator_mode_p] } {
@@ -824,7 +824,7 @@
set url "http://babel.altavista.com/translate.dyn?doit=done&BabelFishFrontPage=yes&bblType=urltext&url="
set babel_result [ns_httpget "$url&lp=$lang&urltext=[ns_urlencode $qmsg]"]
set result_pattern "$marker (\[^<\]*)"
- if [regexp -nocase $result_pattern $babel_result ignore msg_tr] {
+ if {[regexp -nocase $result_pattern $babel_result ignore msg_tr]} {
regsub "$marker." $msg_tr "" msg_tr
return [string trim $msg_tr]
} else {
@@ -845,7 +845,7 @@
if { ![nsv_exists lang_message_cache executed_p] } {
nsv_set lang_message_cache executed_p 1
- if { [empty_string_p $package_key] } {
+ if { $package_key eq "" } {
set package_where_clause ""
} else {
set package_where_clause "where package_key = :package_key"
Index: openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl,v
diff -u -r1.43 -r1.44
--- openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl 13 Jul 2006 23:01:40 -0000 1.43
+++ openacs-4/packages/acs-lang/tcl/lang-util-procs.tcl 10 Jan 2007 21:22:04 -0000 1.44
@@ -47,7 +47,7 @@
set lang(fr) "XFrench"
set lang(es) "XSpanish"
- if { [empty_string_p $locale] || ![info exists lang($locale)] } {
+ if { $locale eq "" || ![info exists lang($locale)] } {
return $field
} else {
return "NLSSORT($field,'NLS_SORT = $lang($locale)')"
@@ -109,11 +109,11 @@
set start_idx [lindex $key_match_idx 0]
set end_idx [lindex $key_match_idx 1]
- lappend indices_list [list [expr $multilingual_string_offset + $start_idx] \
- [expr $multilingual_string_offset + $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 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]
}
@@ -214,12 +214,12 @@
# if the message key is the _ symbol (an underscore) then automatically generate a key
# based on the message text
- if { [string equal $message_key "_"] } {
+ if {$message_key eq "_"} {
set message_key [suggest_key $new_text]
}
# If this is an adp file - replace adp variable syntax with percentage variables
- if { [string equal $file_ending "adp"] } {
+ if {$file_ending eq "adp"} {
set new_text [convert_adp_variables_to_percentage_signs $new_text]
}
@@ -229,10 +229,10 @@
while { 1 } {
set existing_text [lindex [array get messages_array $unique_key] 1]
- if { ![empty_string_p $existing_text] } {
+ if { $existing_text ne "" } {
# The key already exists
- if { [string equal $existing_text $new_text] } {
+ if {$existing_text 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 - \
message key $unique_key already exists in catalog \
@@ -242,12 +242,12 @@
break
} else {
# New and old texts differ, try to make the key unique and check again
- set unique_key "${message_key}_[expr ${key_comp_counter} + 1]"
+ set unique_key "${message_key}_[expr {${key_comp_counter} + 1}]"
}
} else {
# The key is new - save it in the array for addition
- if { ![string equal $message_key $unique_key] } {
+ if { $message_key ne $unique_key } {
# The message key had to be changed to be made unique
ns_log Warning [list lang::util::replace_temporary_tags_with_lookups - \
The message key $message_key was changed to $unique_key \
@@ -326,7 +326,7 @@
return $string_with_hashes
}
- if {[string equal "" $locale]} {
+ if {$locale eq ""} {
set locale [ad_conn locale]
}
@@ -338,18 +338,18 @@
# The replacement string starts and ends with a hash mark
set replacement_string [string range $string_with_hashes [lindex $item_idx 0] \
[lindex $item_idx 1]]
- set message_key [string range $replacement_string 1 [expr [string length $replacement_string] - 2]]
+ set message_key [string range $replacement_string 1 [expr {[string length $replacement_string] - 2}]]
# 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 [expr [lindex $item_idx 0]-1]]
+ append subst_string [string range $string_with_hashes $start_idx [expr {[lindex $item_idx 0]-1}]]
append subst_string $message_value
- set start_idx [expr [lindex $item_idx 1] + 1]
+ set start_idx [expr {[lindex $item_idx 1] + 1}]
}
append subst_string [string range $string_with_hashes $start_idx end]
@@ -537,8 +537,8 @@
#ns_write "input== s=[string range $s 0 600]\n"
set x {}
- while {![empty_string_p $s] && $n < 1000} {
- if { $state == "text" } {
+ while {$s ne "" && $n < 1000} {
+ if { $state eq "text" } {
# clip non tag stuff
if {![regexp {(^[^<]*?)(<.*)$} $s match text s x]} {
@@ -565,7 +565,7 @@
regexp {^(\s*)(.*?)(\s*)$} $text match lead text lag
- if { $mode == "report" } {
+ if { $mode eq "report" } {
# create a key for the text
set key [suggest_key $text]
@@ -575,7 +575,7 @@
# Write mode
if { [llength $keys] != 0} {
# Use keys supplied
- if { [lindex $keys $n] != "" } {
+ if { [lindex $keys $n] ne "" } {
# Use supplied key
set write_key [lindex $keys $n]
} else {
@@ -587,7 +587,7 @@
set write_key [suggest_key $text]
}
- if { ![empty_string_p $write_key] } {
+ if { $write_key ne "" } {
# Write tag to file
lappend report [list ${write_key} "<code>[string range [remove_gt_lt $out$lead] end-20 end]<b><span style=\"background:yellow\">$text</span></b>[string range [remove_gt_lt $lag$s] 0 20]</code>" ]
@@ -623,7 +623,7 @@
}
set state tag
- } elseif { $state == "tag"} {
+ } elseif { $state eq "tag"} {
if {![regexp {(^<[^>]*?>)(.*)$} $s match tag s]} {
set s {}
}
@@ -633,7 +633,7 @@
}
}
- if { $mode == "write" } {
+ if { $mode eq "write" } {
if { $n > 0 } {
# backup original file - fail silently if backup already exists
@@ -698,7 +698,7 @@
global __lang_message_lookups
# Only makes sense to offer translation list if we're not in en_US locale
- if { ![string equal [ad_conn locale] "en_US"] } {
+ if { [ad_conn locale] ne "en_US" } {
if { ![info exists __lang_message_lookups] } {
lappend __lang_message_lookups $message_key
} elseif { [lsearch -exact $__lang_message_lookups $message_key] == -1 } {
@@ -768,8 +768,8 @@
# magic, otherwise just return the text again.
if {[apm_package_id_from_key acs-translations]} {
- if {[empty_string_p $message_key]} {
- if {[empty_string_p $prefix]} {
+ if {$message_key eq ""} {
+ if {$prefix eq ""} {
# Having no prefix or message_key is discouraged as it
# might have interesting side effects due to double
# meanings of the same english string in multiple contexts
Index: openacs-4/packages/acs-lang/tcl/lang-widget-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/lang-widget-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-lang/tcl/lang-widget-procs.tcl 15 Dec 2006 00:01:32 -0000 1.3
+++ openacs-4/packages/acs-lang/tcl/lang-widget-procs.tcl 10 Jan 2007 21:22:04 -0000 1.4
@@ -33,7 +33,7 @@
append output "<select name=\"$element(name)\" "
foreach name [array names attributes] {
- if { [string equal $attributes($name) {}] } {
+ if {$attributes($name) eq {}} {
append output " $name=\"$name\""
} else {
append output " $name=\"$attributes($name)\""
Index: openacs-4/packages/acs-lang/tcl/locale-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/locale-procs.tcl,v
diff -u -r1.34 -r1.35
--- openacs-4/packages/acs-lang/tcl/locale-procs.tcl 4 Jun 2006 00:45:39 -0000 1.34
+++ openacs-4/packages/acs-lang/tcl/locale-procs.tcl 10 Jan 2007 21:22:04 -0000 1.35
@@ -81,7 +81,7 @@
return [site_wide_locale]
}
- if { [empty_string_p $package_id] && [ad_conn isconnected] } {
+ if { $package_id eq "" && [ad_conn isconnected] } {
set package_id [ad_conn package_id]
}
@@ -90,7 +90,7 @@
set locale [package_level_locale $package_id]
# If there's no package setting, use the site-wide setting
- if { [empty_string_p $locale] } {
+ if { $locale eq "" } {
set locale [site_wide_locale]
}
return $locale
@@ -106,7 +106,7 @@
@param package_id The package for which you want to set the locale setting, if you want to set system setting for one package only. Leave blank for site-wide setting.
@param locale The new locale that you want to use as your system locale.
} {
- if { [empty_string_p $package_id] } {
+ if { $package_id eq "" } {
parameter::set_value \
-package_id [apm_package_id_from_key "acs-lang"] \
@@ -266,7 +266,7 @@
given by its package id.
} {
# default to current user
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
set user_id [ad_conn untrusted_user_id]
}
@@ -285,7 +285,7 @@
Get the user's preferred site wide locale.
} {
# default to current user
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
set user_id [ad_conn untrusted_user_id]
}
@@ -307,7 +307,7 @@
set system_locale [lang::system::site_wide_locale]
if { $user_id == 0 } {
set locale [ad_get_cookie "ad_locale"]
- if { [empty_string_p $locale] } {
+ if { $locale eq "" } {
set locale $system_locale
}
return $locale
@@ -331,20 +331,20 @@
@param user_id Set this to the user you want to get the locale of, defaults to current user.
} {
# default to current user
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
set user_id [ad_conn untrusted_user_id]
}
# default to current connection package
- if { [empty_string_p $package_id] } {
+ if { $package_id eq "" } {
set package_id [ad_conn package_id]
}
# Try package level locale first
set locale [package_level_locale -user_id $user_id $package_id]
# If there's no package setting, then use the site-wide setting
- if { [empty_string_p $locale] } {
+ if { $locale eq "" } {
set locale [site_wide_locale -user_id $user_id]
}
@@ -374,7 +374,7 @@
return
}
- if { [empty_string_p $package_id] } {
+ if { $package_id eq "" } {
# Set site-wide locale in user_preferences table
db_dml set_user_site_wide_locale {}
@@ -388,13 +388,13 @@
set user_locale_exists_p [db_string user_locale_exists_p {}]
if { $user_locale_exists_p } {
- if { ![empty_string_p $locale] } {
+ if { $locale ne "" } {
db_dml update_user_locale {}
} else {
db_dml delete_user_locale {}
}
} else {
- if { ![empty_string_p $locale] } {
+ if { $locale ne "" } {
db_dml insert_user_locale {}
}
}
@@ -479,15 +479,15 @@
} {
if { $site_wide_p } {
set locale [lang::user::site_wide_locale]
- if { [empty_string_p $locale] } {
+ if { $locale eq "" } {
set locale [lang::system::site_wide_locale]
}
return $locale
}
# default value for package_id
- if { [empty_string_p $package_id] } {
+ if { $package_id eq "" } {
set package_id [ad_conn package_id]
}
@@ -497,32 +497,32 @@
# if that does not exist use system's package level locale
- if { [empty_string_p $locale] } {
+ if { $locale eq "" } {
set locale [lang::system::package_level_locale $package_id]
}
# if that does not exist use user's site wide locale
- if { [empty_string_p $locale] } {
+ if { $locale eq "" } {
set locale [lang::user::site_wide_locale]
}
# Use the accept-language browser heading
- if { [empty_string_p $locale] } {
+ if { $locale eq "" } {
set locale [lang::conn::browser_locale]
}
# if that does not exist use system's site wide locale
- if { [empty_string_p $locale] } {
+ if { $locale eq "" } {
set locale [lang::system::site_wide_locale]
}
# if that does not exist then we are back to just another language
# let's pick uhmm... en_US
- if { [empty_string_p $locale] } {
+ if { $locale eq "" } {
set locale en_US
}
@@ -558,7 +558,7 @@
# i.e. a tentative match
if { ![info exists tentative_match] } {
set default_locale [lang::util::default_locale_from_lang $language]
- if { ![empty_string_p $default_locale] } {
+ if { $default_locale ne "" } {
set tentative_match $default_locale
}
} else {
@@ -570,7 +570,7 @@
} else {
# We have just a language, e.g. en
set default_locale [lang::util::default_locale_from_lang $locale]
- if { ![empty_string_p $default_locale] } {
+ if { $default_locale ne "" } {
set perfect_match $default_locale
break
}
@@ -650,7 +650,7 @@
set timezone [lang::user::timezone]
}
- if { [empty_string_p $timezone] } {
+ if { $timezone eq "" } {
# No user timezone, return the system timezone
set timezone [lang::system::timezone]
}
Index: openacs-4/packages/acs-lang/tcl/localization-data-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/localization-data-init.tcl,v
diff -u -r1.17 -r1.18
--- openacs-4/packages/acs-lang/tcl/localization-data-init.tcl 3 Mar 2005 12:15:23 -0000 1.17
+++ openacs-4/packages/acs-lang/tcl/localization-data-init.tcl 10 Jan 2007 21:22:04 -0000 1.18
@@ -95,7 +95,7 @@
# Composites, now directly expanded, note that writing for %r specifically would be quicker than what we have here.
set percent_match(T) {[lc_leading_zeros $lc_time_hours 2]:[lc_leading_zeros $lc_time_minutes 2]:[lc_leading_zeros $lc_time_seconds 2]}
- set percent_match(D) {[lc_leading_zeros $lc_time_days 2]/[lc_leading_zeros $lc_time_month 2]/[lc_leading_zeros [expr $lc_time_year%100] 2]}
+ set percent_match(D) {[lc_leading_zeros $lc_time_days 2]/[lc_leading_zeros $lc_time_month 2]/[lc_leading_zeros [expr {$lc_time_year%100}] 2]}
set percent_match(F) {${lc_time_year}-[lc_leading_zeros $lc_time_month 2]-[lc_leading_zeros $lc_time_days 2]}
set percent_match(r) {[lc_leading_zeros [lc_time_drop_meridian $lc_time_hours] 2]:[lc_leading_zeros $lc_time_minutes 2] [lc_time_name_meridian $locale $lc_time_hours]}
@@ -113,18 +113,18 @@
set percent_match(M) {[lc_leading_zeros $lc_time_minutes 2]}
# Calculable values (based on assumptions above)
- set percent_match(C) {[expr int($lc_time_year/100)]}
+ set percent_match(C) {[expr {int($lc_time_year/100)}]}
set percent_match(I) {[lc_leading_zeros [lc_time_drop_meridian $lc_time_hours] 2]}
- set percent_match(w) {[expr $lc_time_day_no]}
- set percent_match(y) {[lc_leading_zeros [expr $lc_time_year%100] 2]}
+ set percent_match(w) {[expr {$lc_time_day_no}]}
+ set percent_match(y) {[lc_leading_zeros [expr {$lc_time_year%100}] 2]}
set percent_match(Z) [lang::conn::timezone]
# Straight (localian) lookups
set percent_match(a) {[lindex [lc_get -locale $locale "abday"] $lc_time_day_no]}
set percent_match(A) {[lindex [lc_get -locale $locale "day"] $lc_time_day_no]}
- set percent_match(b) {[lindex [lc_get -locale $locale "abmon"] [expr $lc_time_month-1]]}
- set percent_match(h) {[lindex [lc_get -locale $locale "abmon"] [expr $lc_time_month-1]]}
- set percent_match(B) {[lindex [lc_get -locale $locale "mon"] [expr $lc_time_month-1]]}
+ set percent_match(b) {[lindex [lc_get -locale $locale "abmon"] [expr {$lc_time_month-1}]]}
+ set percent_match(h) {[lindex [lc_get -locale $locale "abmon"] [expr {$lc_time_month-1}]]}
+ set percent_match(B) {[lindex [lc_get -locale $locale "mon"] [expr {$lc_time_month-1}]]}
set percent_match(p) {[lc_time_name_meridian $locale $lc_time_hours]}
# Finally, static string replacements
Index: openacs-4/packages/acs-lang/tcl/localization-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/localization-procs.tcl,v
diff -u -r1.19 -r1.20
--- openacs-4/packages/acs-lang/tcl/localization-procs.tcl 15 Dec 2006 00:01:32 -0000 1.19
+++ openacs-4/packages/acs-lang/tcl/localization-procs.tcl 10 Jan 2007 21:22:04 -0000 1.20
@@ -39,7 +39,7 @@
@return Canonical form of the number
} {
- if {[empty_string_p $num]} {
+ if {$num eq ""} {
return ""
}
@@ -81,7 +81,7 @@
# if number is real and mod(number)<1, then we have pulled off the leading zero; i.e. 0.231 -> .231 -- this is still fine for tcl though...
# Last pathological case
- if {![string compare "." $number]} {
+ if {"." eq $number } {
set number 0
}
@@ -123,8 +123,8 @@
} {
# with empty seperator or grouping string we behave
# posixly
- if {[empty_string_p $grouping]
- || [empty_string_p $sep] } {
+ if {$grouping eq ""
+ || $sep eq "" } {
return $num
}
@@ -165,7 +165,7 @@
@return Localized form of the number
} {
- if {![empty_string_p $fmt]} {
+ if {$fmt ne ""} {
set out [format $fmt $num]
} else {
set out $num
@@ -215,7 +215,7 @@
}
if { $label_p } {
- if {[string compare $style int] == 0} {
+ if {$style eq "int" } {
set use_as_label $currency
} else {
set use_as_label $html_entity
@@ -249,11 +249,11 @@
@return Formatted monetary amount
} {
- if {![empty_string_p $forced_frac_digits] && [string is integer $forced_frac_digits]} {
+ if {$forced_frac_digits ne "" && [string is integer $forced_frac_digits]} {
set dig $forced_frac_digits
} else {
# look up the digits
- if {[string compare $style int] == 0} {
+ if {$style eq "int" } {
set dig [lc_get -locale $locale "int_frac_digits"]
} else {
set dig [lc_get -locale $locale "frac_digits"]
@@ -262,7 +262,7 @@
# figure out if negative
if {$num < 0} {
- set num [expr abs($num)]
+ set num [expr {abs($num)}]
set neg 1
} else {
set neg 0
@@ -272,9 +272,9 @@
set out [format "%.${dig}f" $num]
# look up the label if needed
- if {[empty_string_p $forced_currency_symbol]} {
+ if {$forced_currency_symbol eq ""} {
if {$label_p} {
- if {[string compare $style int] == 0} {
+ if {$style eq "int" } {
set sym [lc_get -locale $locale "int_curr_symbol"]
} else {
set sym [lc_get -locale $locale "currency_symbol"]
@@ -411,7 +411,7 @@
(or have an 'on this day in history' style page that goes back a good few hundred years).
@return A date formatted for a locale
} {
- if { [empty_string_p $datetime] } {
+ if { $datetime eq "" } {
return ""
}
@@ -438,8 +438,8 @@
}
set a [expr (14 - $lc_time_month) / 12]
- set y [expr $lc_time_year - $a]
- set m [expr $lc_time_month + 12*$a - 2]
+ set y [expr {$lc_time_year - $a}]
+ set m [expr {$lc_time_month + 12*$a - 2}]
# day_no becomes 0 for Sunday, through to 6 for Saturday. Perfect for addressing zero-based lists pulled from locale info.
set lc_time_day_no [expr (($lc_time_days + $y + ($y/4) - ($y / 100) + ($y / 400)) + ((31*$m) / 12)) % 7]
@@ -507,7 +507,7 @@
@param tz Timezone that must exist in tz_data table.
@return Local time
} {
- if { [empty_string_p $tz] } {
+ if { $tz eq "" } {
set tz [lang::conn::timezone]
}
@@ -520,7 +520,7 @@
ns_log Warning "lc_time_utc_to_local: Query exploded on time conversion from UTC, probably just an invalid date, $time_value: $errmsg"
}
- if {[empty_string_p $local_time]} {
+ if {$local_time eq ""} {
# If no conversion possible, log it and assume local is as given (i.e. UTC)
ns_log Notice "lc_time_utc_to_local: Timezone adjustment in ad_localization.tcl found no conversion to UTC for $time_value $tz"
}
@@ -538,7 +538,7 @@
@param tz Timezone that must exist in tz_data table.
@return UTC time.
} {
- if { [empty_string_p $tz] } {
+ if { $tz eq "" } {
set tz [lang::conn::timezone]
}
@@ -550,7 +550,7 @@
ns_log Warning "lc_time_local_to_utc: Query exploded on time conversion to UTC, probably just an invalid date, $time_value: $errmsg"
}
- if {[empty_string_p $utc_time]} {
+ if {$utc_time eq ""} {
# If no conversion possible, log it and assume local is as given (i.e. UTC)
ns_log Notice "lc_time_local_to_utc: Timezone adjustment in ad_localization.tcl found no conversion to local time for $time_value $tz"
}
@@ -577,7 +577,7 @@
set system_tz [lang::system::timezone]
set conn_tz [lang::conn::timezone]
- if { [empty_string_p $conn_tz] || [string equal $system_tz $conn_tz] } {
+ if { $conn_tz eq "" || $system_tz eq $conn_tz } {
return $time_value
}
@@ -600,7 +600,7 @@
set system_tz [lang::system::timezone]
set conn_tz [lang::conn::timezone]
- if { [empty_string_p $conn_tz] || [string equal $system_tz $conn_tz] } {
+ if { $conn_tz eq "" || $system_tz eq $conn_tz } {
return $time_value
}
Index: openacs-4/packages/acs-lang/tcl/test/acs-lang-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/tcl/test/acs-lang-test-procs.tcl,v
diff -u -r1.16 -r1.17
--- openacs-4/packages/acs-lang/tcl/test/acs-lang-test-procs.tcl 20 Apr 2004 21:12:48 -0000 1.16
+++ openacs-4/packages/acs-lang/tcl/test/acs-lang-test-procs.tcl 10 Jan 2007 21:22:04 -0000 1.17
@@ -114,12 +114,12 @@
aa_equals "Import check: $message_key - lang_messages.conflict_p" $message_actual(conflict_p) $expect_property(conflict_p)
aa_equals "Import check: $message_key - lang_messages.upgrade_status" \
$message_actual(upgrade_status) $expect_property(upgrade_status)
- if { [string equal $expect_property(sync_time) "not_null"] } {
+ if {$expect_property(sync_time) eq "not_null"} {
aa_true "Import check: $message_key - lang_messages.sync_time not null" \
- [expr ![empty_string_p $message_actual(sync_time)]]
+ [expr {$message_actual(sync_time) ne ""}]
} else {
aa_true "Import check: $message_key - lang_messages.sync_time null" \
- [expr [empty_string_p $message_actual(sync_time)]]
+ [expr {$message_actual(sync_time) eq ""}]
}
}
}
@@ -350,7 +350,7 @@
# Message is supposed to exist in DB
# Is it new or changed?
if { ![info exists base_messages($message_key)] || \
- ![string equal $base_messages($message_key) $db_messages($message_key)] } {
+ $base_messages($message_key) ne $db_messages($message_key) } {
# Added || updated
aa_log "Adding/updating message $message_key"
lang::message::register \
@@ -414,7 +414,7 @@
key08 "accept"
}
foreach message_key [array names conflict_resolutions] {
- if { [string equal $conflict_resolutions($message_key) "accept"] } {
+ if {$conflict_resolutions($message_key) eq "accept"} {
# Resolution is an accept - just toggle conflict_p flag
lang::message::edit $package_key $message_key $locale [list conflict_p f]
@@ -581,7 +581,7 @@
set indices_list [lang::util::get_hash_indices $multilingual_string]
set expected_indices_list [list [list 0 14] [list 21 35]]
- aa_true "there should be two hash entries" [expr [llength $indices_list] == 2]
+ aa_true "there should be two hash entries" [expr {[llength $indices_list] == 2}]
set counter 0
foreach index_item $indices_list {
@@ -591,7 +591,7 @@
[expr [string equal [lindex $index_item 0] [lindex $expected_index_item 0]] && \
[string equal [lindex $index_item 1] [lindex $expected_index_item 1]]]
- set counter [expr $counter + 1]
+ set counter [expr {$counter + 1}]
}
}
@@ -861,8 +861,8 @@
set timezones [lc_list_all_timezones]
- set desired_user_timezone [lindex [lindex $timezones [randomRange [expr [llength $timezones]-1]]] 0]
- set desired_system_timezone [lindex [lindex $timezones [randomRange [expr [llength $timezones]-1]]] 0]
+ set desired_user_timezone [lindex [lindex $timezones [randomRange [expr {[llength $timezones]-1}]]] 0]
+ set desired_system_timezone [lindex [lindex $timezones [randomRange [expr {[llength $timezones]-1}]]] 0]
set error_p 0
with_catch errmsg {
Index: openacs-4/packages/acs-lang/www/change-locale-include.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/change-locale-include.tcl,v
diff -u -r1.14 -r1.15
--- openacs-4/packages/acs-lang/www/change-locale-include.tcl 3 Nov 2006 20:24:09 -0000 1.14
+++ openacs-4/packages/acs-lang/www/change-locale-include.tcl 10 Jan 2007 21:22:04 -0000 1.15
@@ -13,7 +13,7 @@
set package_id [ad_conn package_id]
}
-set use_timezone_p [expr [lang::system::timezone_support_p] && [ad_conn user_id]]
+set use_timezone_p [expr {[lang::system::timezone_support_p] && [ad_conn user_id]}]
#
# LARS:
@@ -53,7 +53,7 @@
}
# are we selecting package level locale as well?
-set package_level_locales_p [expr [lang::system::use_package_level_locales_p] && ![empty_string_p $package_id] && [ad_conn user_id] != 0]
+set package_level_locales_p [expr {[lang::system::use_package_level_locales_p] && $package_id ne "" && [ad_conn user_id] != 0}]
if { $package_level_locales_p } {
element create locale site_wide_explain -datatype text -widget inform -label " " \
@@ -91,7 +91,7 @@
}
set site_wide_locale [lang::user::site_wide_locale]
- if { [empty_string_p $site_wide_locale] } {
+ if { $site_wide_locale eq "" } {
set site_wide_locale [lang::system::site_wide_locale]
}
@@ -101,7 +101,7 @@
if { $use_timezone_p } {
set timezone [lang::user::timezone]
- if { [empty_string_p $timezone] } {
+ if { $timezone eq "" } {
set timezone [lang::system::timezone]
}
element set_properties locale timezone -value $timezone
Index: openacs-4/packages/acs-lang/www/admin/batch-editor.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/batch-editor.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-lang/www/admin/batch-editor.tcl 26 Feb 2005 16:00:10 -0000 1.6
+++ openacs-4/packages/acs-lang/www/admin/batch-editor.tcl 10 Jan 2007 21:22:04 -0000 1.7
@@ -83,7 +83,7 @@
(select count(*) from lang_message_keys where package_key = :package_key) as num_messages
from dual
}
-set num_untranslated [expr $num_messages - $num_translated]
+set num_untranslated [expr {$num_messages - $num_translated}]
set num_messages_pretty [lc_numeric $num_messages]
set num_translated_pretty [lc_numeric $num_translated]
@@ -109,7 +109,7 @@
"]
set total [llength $keys]
-set page_end [expr $page_start + 10]
+set page_end [expr {$page_start + 10}]
@@ -123,13 +123,13 @@
set edit_buttons [list]
-if { ![string equal $show "untranslated"] && $page_start > 0 } {
+if { $show ne "untranslated" && $page_start > 0 } {
lappend edit_buttons { "< Update and back" "prev" }
}
lappend edit_buttons { "Update" "ok" }
-if { ![string equal $show "untranslated"] && $page_end < [expr $total] } {
+if { $show ne "untranslated" && $page_end < [expr {$total}] } {
lappend edit_buttons { "Update and next >" "next" }
}
@@ -163,7 +163,7 @@
{value "<a href=\"$message_url\">$package_key.$message_key</a>"} \
{section "$package_key.$message_key"}]]
- if { ![empty_string_p $description] } {
+ if { $description ne "" } {
set description_edit_url "edit-description?[export_vars { locale package_key message_key show }]"
set description "[ad_text_to_html -- $description] [subst { (<a href="$description_edit_url">edit</a>)}]"
@@ -173,7 +173,7 @@
{value $description}]]
}
- if { ![string equal $current_locale $default_locale] } {
+ if { $current_locale ne $default_locale } {
ad_form -extend -name batch_editor -form \
[list [list "default_locale_message_$count:text(inform),optional" \
{label $default_locale_label} \
@@ -205,7 +205,7 @@
for { set i $page_start } { $i < $page_end && $i < $total } { incr i } {
- if { ![string equal [set org_message_$i] [set message_$i]] } {
+ if { [set org_message_$i] ne [set message_$i] } {
lang::message::register $current_locale $package_key \
[set message_key_$i] \
[set message_$i]
@@ -214,18 +214,18 @@
set button [form::get_button batch_editor]
- if { ![string equal $button "ok"] } {
+ if { $button ne "ok" } {
switch $button {
prev {
- set page_start [expr $page_start - 10]
+ set page_start [expr {$page_start - 10}]
if { $page_start < 0 } {
set page_start 0
}
}
next {
- set page_start [expr $page_start + 10]
+ set page_start [expr {$page_start + 10}]
if { $page_start > $total } {
- set page_start [expr $total - ($total % 10)]
+ set page_start [expr {$total - ($total % 10)}]
}
}
}
@@ -246,9 +246,9 @@
multirow create pagination text hint url selected group
for {set count 0} {$count < $total} {incr count 10 } {
- set end_page [expr $count + 9]
- if { $end_page > [expr $total-1] } {
- set end_page [expr $total-1]
+ set end_page [expr {$count + 9}]
+ if { $end_page > [expr {$total-1}] } {
+ set end_page [expr {$total-1}]
}
@@ -269,8 +269,8 @@
$text \
"[lindex $keys $count] - [lindex $keys $end_page]" \
"batch-editor?[export_vars { { page_start $count } locale package_key show }]" \
- [expr $count == $page_start] \
- [expr $count / 100]
+ [expr {$count == $page_start}] \
+ [expr {$count / 100}]
}
@@ -293,7 +293,7 @@
multirow foreach show_opts {
set selected_p [string equal $show $value]
- if { [string equal $value "all"] } {
+ if {$value eq "all"} {
set url "[ad_conn url]?[export_vars { locale package_key }]"
} else {
set url "[ad_conn url]?[export_vars { locale package_key {show $value} }]"
Index: openacs-4/packages/acs-lang/www/admin/edit-localized-message.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/edit-localized-message.tcl,v
diff -u -r1.15 -r1.16
--- openacs-4/packages/acs-lang/www/admin/edit-localized-message.tcl 15 Dec 2006 00:01:34 -0000 1.15
+++ openacs-4/packages/acs-lang/www/admin/edit-localized-message.tcl 10 Jan 2007 21:22:04 -0000 1.16
@@ -20,7 +20,7 @@
if { [string length $locale] == 2 } {
# Only language provided, let's get the default locale for this language
set default_locale [lang::util::default_locale_from_lang $locale]
- if { [empty_string_p $default_locale] } {
+ if { $default_locale eq "" } {
error "Could not look up locale for language $locale"
} else {
set locale $default_locale
@@ -68,7 +68,7 @@
}
}
-if { ![string equal $default_locale $current_locale] } {
+if { $default_locale ne $current_locale } {
ad_form -extend -name message -form {
{original_message:text(inform)
{label "$default_locale_label Message"}
@@ -124,14 +124,14 @@
set message $original_message
}
- if { [empty_string_p $description] } {
+ if { $description eq "" } {
set description [subst {(<a href="$description_edit_url">add description</a>)}]
} else {
set description "[ad_text_to_html -- $description] [subst { (<a href="$description_edit_url">edit</a>)}]"
}
# Augment the audit trail with info on who created the first message
- if { ![string equal $current_locale $default_locale] && $translated_p } {
+ if { $current_locale ne $default_locale && $translated_p } {
set edited_p [db_string edit_count {
select count(*)
from lang_messages_audit
@@ -171,7 +171,7 @@
# Register message via acs-lang
lang::message::register -comment $comment $locale $package_key $message_key $message
- if { [empty_string_p $return_url] } {
+ if { $return_url eq "" } {
set return_url "[ad_conn url]?[export_vars { locale package_key message_key show }]"
}
ad_returnredirect $return_url
Index: openacs-4/packages/acs-lang/www/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/index.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-lang/www/admin/index.tcl 26 Feb 2005 16:00:10 -0000 1.8
+++ openacs-4/packages/acs-lang/www/admin/index.tcl 10 Jan 2007 21:22:04 -0000 1.9
@@ -69,6 +69,6 @@
set locale_enabled_p_url "locale-set-enabled-p?[export_vars { locale {enabled_p $toggle_enabled_p} }]"
set num_translated_pretty [lc_numeric $num_translated]
- set num_untranslated [expr $num_messages - $num_translated]
+ set num_untranslated [expr {$num_messages - $num_translated}]
set num_untranslated_pretty [lc_numeric $num_untranslated]
}
Index: openacs-4/packages/acs-lang/www/admin/locale-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/locale-edit.tcl,v
diff -u -r1.7 -r1.8
--- openacs-4/packages/acs-lang/www/admin/locale-edit.tcl 26 Feb 2005 16:00:10 -0000 1.7
+++ openacs-4/packages/acs-lang/www/admin/locale-edit.tcl 10 Jan 2007 21:22:04 -0000 1.8
@@ -129,10 +129,10 @@
set locale_label [lang::util::get_label $locale]
- if { $label == "" } {
+ if { $label eq "" } {
element set_error locale_editing label "Label is required"
}
- if { $mime_charset == "" } {
+ if { $mime_charset eq "" } {
element set_error locale_editing mime_charset "Mime charset is required"
}
Index: openacs-4/packages/acs-lang/www/admin/localized-message-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/localized-message-new.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-lang/www/admin/localized-message-new.tcl 4 Jun 2006 00:45:40 -0000 1.8
+++ openacs-4/packages/acs-lang/www/admin/localized-message-new.tcl 10 Jan 2007 21:22:04 -0000 1.9
@@ -35,7 +35,7 @@
# locale. If not, we can't allow the creation of a new localized
# message.
-if { ![string equal $current_locale $default_locale] } {
+if { $current_locale ne $default_locale } {
ad_return_error "Can only create messages in the default locale" "Can only create messages in the default locale"
ad_script_abort
}
@@ -64,7 +64,7 @@
element set_value message_new locale $current_locale
element set_value message_new message_key $message_key
element set_value message_new return_url $return_url
- if { [empty_string_p $message_key] } {
+ if { $message_key eq "" } {
set focus message_new.message_key
} else {
set focus message_new.message
Index: openacs-4/packages/acs-lang/www/admin/message-list.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/message-list.tcl,v
diff -u -r1.11 -r1.12
--- openacs-4/packages/acs-lang/www/admin/message-list.tcl 3 Jul 2006 12:29:50 -0000 1.11
+++ openacs-4/packages/acs-lang/www/admin/message-list.tcl 10 Jan 2007 21:22:04 -0000 1.12
@@ -66,7 +66,7 @@
and deleted_p = 't') as num_deleted
from dual
}
-set num_untranslated [expr $num_messages - $num_translated]
+set num_untranslated [expr {$num_messages - $num_translated}]
set num_messages_pretty [lc_numeric $num_messages]
set num_translated_pretty [lc_numeric $num_translated]
set num_untranslated_pretty [lc_numeric $num_untranslated]
@@ -145,7 +145,7 @@
multirow foreach show_opts {
set selected_p [string equal $show $value]
- if { [string equal $value "all"] } {
+ if {$value eq "all"} {
set url "[ad_conn url]?[export_vars { locale package_key }]"
} else {
set url "[ad_conn url]?[export_vars { locale package_key {show $value} }]"
Index: openacs-4/packages/acs-lang/www/admin/message-search.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/message-search.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-lang/www/admin/message-search.tcl 26 Feb 2005 16:00:10 -0000 1.3
+++ openacs-4/packages/acs-lang/www/admin/message-search.tcl 10 Jan 2007 21:22:04 -0000 1.4
@@ -31,7 +31,7 @@
{locale:text(hidden) {value $locale}}
}
-if { ![string equal $default_locale $current_locale] } {
+if { $default_locale ne $current_locale } {
ad_form -extend -name search -form {
{search_locale:text(select)
{options $search_locales}
@@ -69,8 +69,8 @@
set message_key_pretty "$package_key.$message_key"
}
- if { ![string equal $current_locale $default_locale] } {
- if { [string equal $default_locale $search_locale] } {
+ if { $current_locale ne $default_locale } {
+ if {$default_locale eq $search_locale} {
set other_locale $locale_label
set other_search_url "[ad_conn url]?[export_vars { locale q {search_locale $current_locale} }]"
} else {
Index: openacs-4/packages/acs-lang/www/admin/message-usage-include.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/message-usage-include.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-lang/www/admin/message-usage-include.tcl 29 Jun 2004 10:17:41 -0000 1.4
+++ openacs-4/packages/acs-lang/www/admin/message-usage-include.tcl 10 Jan 2007 21:22:04 -0000 1.5
@@ -28,8 +28,8 @@
set colon [string first ":" $line]
multirow append message_usage \
- [string range $line 0 [expr $colon-1]] \
- [string trim [string range $line [expr $colon+1] end]]
+ [string range $line 0 [expr {$colon-1}]] \
+ [string trim [string range $line [expr {$colon+1}] end]]
}
}
}
Index: openacs-4/packages/acs-lang/www/admin/package-list.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/package-list.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-lang/www/admin/package-list.tcl 26 Feb 2005 16:00:10 -0000 1.6
+++ openacs-4/packages/acs-lang/www/admin/package-list.tcl 10 Jan 2007 21:22:04 -0000 1.7
@@ -61,7 +61,7 @@
group by package_key) q
order by package_key
} {
- set num_untranslated [expr $num_messages - $num_translated]
+ set num_untranslated [expr {$num_messages - $num_translated}]
set num_messages_pretty [lc_numeric $num_messages]
set num_translated_pretty [lc_numeric $num_translated]
@@ -92,7 +92,7 @@
{locale:text(hidden) {value $locale}}
}
-if { ![string equal $default_locale $current_locale] } {
+if { $default_locale ne $current_locale } {
ad_form -extend -name search -form {
{search_locale:text(select)
{options $search_locales}
Index: openacs-4/packages/acs-lang/www/admin/set-system-timezone.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/set-system-timezone.tcl,v
diff -u -r1.7 -r1.8
--- openacs-4/packages/acs-lang/www/admin/set-system-timezone.tcl 13 Jan 2005 13:55:27 -0000 1.7
+++ openacs-4/packages/acs-lang/www/admin/set-system-timezone.tcl 10 Jan 2007 21:22:04 -0000 1.8
@@ -18,9 +18,9 @@
ad_script_abort
}
-if { ![empty_string_p $timezone_recommended] } {
+if { $timezone_recommended ne "" } {
lang::system::set_timezone $timezone_recommended
-} elseif { ![empty_string_p $timezone_all] } {
+} elseif { $timezone_all ne "" } {
lang::system::set_timezone $timezone_all
}
@@ -71,10 +71,10 @@
if { [info exists utc_epoch] } {
with_catch errmsg {
set sysdate_utc_epoch [clock scan $sysdate_utc]
- set delta_hours [expr round(($sysdate_utc_epoch - $utc_epoch)*4.0 / (60*60)) / 4.0]
- set recommended_offset [expr $system_utc_offset + $delta_hours]
+ set delta_hours [expr {round(($sysdate_utc_epoch - $utc_epoch)*4.0 / (60*60)) / 4.0}]
+ set recommended_offset [expr {$system_utc_offset + $delta_hours}]
- set recommended_offset_pretty "UTC [format "+%d:%02d" [expr int($recommended_offset)] [expr int($recommended_offset*60) % 60]]"
+ set recommended_offset_pretty "UTC [format "+%d:%02d" [expr {int($recommended_offset)}] [expr {int($recommended_offset*60) % 60}]]"
if { $delta_hours == 0 } {
set correct_p 1
@@ -83,15 +83,15 @@
}
set try_offsets [list]
- foreach offset [list $recommended_offset [expr $recommended_offset -24]] {
+ foreach offset [list $recommended_offset [expr {$recommended_offset -24}]] {
# LARS 2003-11-05
# This is a workaround for a Tcl 8.3 bug on Solaris that causes int() on negative decimal
# numbers to fail with "integer value too large to represent".
# Example: 'expr int(-1.0)' throws an error; 'expr int(-1)' does not.
if { $offset < 0 } {
lappend try_offsets "'[db_quote [expr -int(abs($offset)*60*60)]]'"
} else {
- lappend try_offsets "'[db_quote [expr int($offset*60*60)]]'"
+ lappend try_offsets "'[db_quote [expr {int($offset*60*60)}]]'"
}
}
Index: openacs-4/packages/acs-lang/www/admin/translator-mode-toggle.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/translator-mode-toggle.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-lang/www/admin/translator-mode-toggle.tcl 25 Oct 2002 15:12:15 -0000 1.1
+++ openacs-4/packages/acs-lang/www/admin/translator-mode-toggle.tcl 10 Jan 2007 21:22:04 -0000 1.2
@@ -8,7 +8,7 @@
{return_url "."}
}
-lang::util::translator_mode_set [expr ![lang::util::translator_mode_p]]
+lang::util::translator_mode_set [expr {![lang::util::translator_mode_p]}]
ad_returnredirect $return_url
Index: openacs-4/packages/acs-lang/www/admin/test/test.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/test/Attic/test.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-lang/www/admin/test/test.tcl 26 Feb 2005 16:00:10 -0000 1.2
+++ openacs-4/packages/acs-lang/www/admin/test/test.tcl 10 Jan 2007 21:22:04 -0000 1.3
@@ -21,12 +21,12 @@
#set lang [lang::user::language]
set lang [ad_get_client_property lang locale]
-if {[empty_string_p $lang]} {
+if {$lang eq ""} {
set lang "en"
}
db_1row lang_get_lang_name "SELECT nls_language as language FROM ad_locales WHERE language = :lang"
-if [empty_string_p $language] {
+if {$language eq ""} {
set language English
}
Index: openacs-4/packages/acs-lang/www/admin/test/timezone.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-lang/www/admin/test/Attic/timezone.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-lang/www/admin/test/timezone.tcl 7 Oct 2002 14:32:49 -0000 1.1
+++ openacs-4/packages/acs-lang/www/admin/test/timezone.tcl 10 Jan 2007 21:22:04 -0000 1.2
@@ -33,7 +33,7 @@
set NYC_time [lc_time_utc_to_local $system_time "America/New_York"]
set NYC_utc_time [lc_time_local_to_utc $NYC_time "America/New_York"]
-if {[string compare $system_time $NYC_utc_time] == 0} {
+if {$system_time eq $NYC_utc_time } {
set NYC_p "OK"
} else {
set NYC_p "<font color=red>FAILED</font>"
@@ -42,23 +42,23 @@
set LA_time [lc_time_utc_to_local $system_time "America/Los_Angeles"]
set LA_utc_time [lc_time_local_to_utc $LA_time "America/Los_Angeles"]
-if {[string compare $system_time $LA_utc_time] == 0} {
+if {$system_time eq $LA_utc_time } {
set LA_p "OK"
} else {
set LA_p "<font color=red>FAILED</font>"
}
set paris_time [lc_time_utc_to_local $system_time "Europe/Paris"]
set paris_utc_time [lc_time_local_to_utc $paris_time "Europe/Paris"]
-if {[string compare $system_time $paris_utc_time] == 0} {
+if {$system_time eq $paris_utc_time } {
set paris_p "OK"
} else {
set paris_p "<font color=red>FAILED</font>"
}
set tokyo_time [lc_time_utc_to_local $system_time "Asia/Tokyo"]
set tokyo_utc_time [lc_time_local_to_utc $tokyo_time "Asia/Tokyo"]
-if {[string compare $system_time $tokyo_utc_time] == 0} {
+if {$system_time eq $tokyo_utc_time } {
set tokyo_p "OK"
} else {
set tokyo_p "<font color=red>FAILED</font>"
Index: openacs-4/packages/acs-mail-lite/lib/email.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/lib/Attic/email.tcl,v
diff -u -r1.27 -r1.28
--- openacs-4/packages/acs-mail-lite/lib/email.tcl 29 Jun 2006 07:51:48 -0000 1.27
+++ openacs-4/packages/acs-mail-lite/lib/email.tcl 10 Jan 2007 21:22:04 -0000 1.28
@@ -39,7 +39,7 @@
set recipients [list]
foreach party_id $party_ids {
- if {![empty_string_p $party_id]} {
+ if {$party_id ne ""} {
if { $contacts_p } {
lappend recipients [list "<a href=\"[contact::url -party_id $party_id]\">[contact::name -party_id $party_id]</a> ([cc_email_from_party $party_id])" $party_id]
} else {
@@ -109,7 +109,7 @@
{html {onclick check_uncheck_boxes(this.checked)}}
}
}
- if {$checked_p == "t"} {
+ if {$checked_p eq "t"} {
append form_elements {
{to:text(checkbox),multiple,optional
{label "[_ acs-mail-lite.Recipients]"}
@@ -132,7 +132,7 @@
set files [list]
foreach file $file_ids {
set file_title [lang::util::localize [content::item::get_title -item_id $file]]
- if {[empty_string_p $file_title]} {
+ if {$file_title eq ""} {
set file_title "empty"
}
if { $tracking_p } {
@@ -151,7 +151,7 @@
# Get the list of files from the file storage folder
set file_folder_id [parameter::get_from_package_key -package_key "acs-mail-lite" -parameter "FolderID"]
-if {![string eq "" $file_folder_id]} {
+if {$file_folder_id ne ""} {
# get the list of files in an option
set file_options [db_list_of_lists files {
select r.title, i.item_id
@@ -160,7 +160,7 @@
and i.content_type = 'file_storage_object'
and r.revision_id = i.latest_revision
}]
- if {![string eq "" $file_options]} {
+ if {$file_options ne ""} {
append form_elements {
{files_extend:text(checkbox),optional
{label "[_ acs-mail-lite.Additional_files]"}
@@ -263,7 +263,7 @@
# Insert the uploaded file linked under the package_id
set package_id [ad_conn package_id]
- if {![empty_string_p $upload_file] } {
+ if {$upload_file ne "" } {
set revision_id [content::item::upload_file \
-package_id $package_id \
-upload_file $upload_file \
@@ -295,15 +295,15 @@
set to_addr [party::email -party_id $party_id]
# This should not be happening in the first place and should be removed from here later....
- if {[empty_string_p $to_addr]} {
+ if {$to_addr eq ""} {
# We are going to check if this party_id has an employer and if this
# employer has an email
set employer_id [relation::get_object_two -object_id_one $party_id \
-rel_type "contact_rels_employment"]
- if { ![empty_string_p $employer_id] } {
+ if { $employer_id ne "" } {
# Get the employer email adress
set to_addr [party::email -party_id $employer_id]
- if {[empty_string_p $to_addr]} {
+ if {$to_addr eq ""} {
ad_return_error [_ acs-kernel.common_Error] [_ acs-mail-lite.lt_there_was_an_error_processing]
break
}
Index: openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-callback-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-callback-procs.tcl,v
diff -u -r1.12 -r1.13
--- openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-callback-procs.tcl 24 Dec 2006 11:09:52 -0000 1.12
+++ openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-callback-procs.tcl 10 Jan 2007 21:22:05 -0000 1.13
@@ -111,8 +111,8 @@
util_unlist [acs_mail_lite::parse_bounce_address -bounce_address $to] user_id package_id signature
# If no user_id found or signature invalid, ignore message
- if {[empty_string_p $user_id]} {
- if {[empty_string_p $user_id]} {
+ if {$user_id eq ""} {
+ if {$user_id eq ""} {
ns_log Debug "acs_mail_lite::incoming_email impl acs-mail-lite: No equivalent user found for $to"
} else {
ns_log Debug "acs_mail_lite::incoming_email impl acs-mail-lite: Invalid mail signature $signature"
Index: openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl,v
diff -u -r1.65 -r1.66
--- openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl 24 Dec 2006 11:09:52 -0000 1.65
+++ openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl 10 Jan 2007 21:22:05 -0000 1.66
@@ -92,7 +92,7 @@
@returns domain address to which bounces are directed to
} {
set domain [get_parameter -name "BounceDomain"]
- if { [empty_string_p $domain] } {
+ if { $domain eq "" } {
regsub {http://} [ns_config ns/server/[ns_info server]/module/nssock hostname] {} domain
}
return $domain
@@ -224,7 +224,7 @@
@option msg message-id that the signature should be checked against
@returns boolean 0 or 1
} {
- if {![regexp "(<\[\-0-9\]+\\.\[0-9\]+\\.oacs@[address_domain]>)" $message_id match id] || ![string equal $signature [ns_sha1 $id]]} {
+ if {![regexp "(<\[\-0-9\]+\\.\[0-9\]+\\.oacs@[address_domain]>)" $message_id match id] || $signature ne [ns_sha1 $id] } {
# either couldn't find message-id or signature doesn't match
return 0
}
@@ -383,7 +383,7 @@
# travers the tree and extract parts into a flat list
set all_parts [list]
foreach part $parts {
- if { [string equal [mime::getproperty $part content] "multipart/alternative" ] } {
+ if {[mime::getproperty $part content] eq "multipart/alternative"} {
foreach child_part [mime::getproperty $part parts] {
lappend all_parts $child_part
}
@@ -414,7 +414,7 @@
set body [mime::getbody $part -decode]
set content $body
set params [mime::getproperty $part params]
- if {[lindex $params 0] == "name"} {
+ if {[lindex $params 0] eq "name"} {
set filename [lindex $params 1]
} else {
set filename ""
@@ -478,8 +478,8 @@
set headers [list]
# walk through the headers and extract each one
- while ![empty_string_p $line] {
- set next_line [lindex $file [expr $i + 1]]
+ while {$line ne ""} {
+ set next_line [lindex $file [expr {$i + 1}]]
if {[regexp {^[ ]*$} $next_line match] && $i > 0} {
set end_of_headers_p 1
}
@@ -511,10 +511,10 @@
# put it into notifications stuff
array set email_headers $headers
- if [catch {set from $email_headers(from)}] {
+ if {[catch {set from $email_headers(from)}]} {
set from ""
}
- if [catch {set to $email_headers(to)}] {
+ if {[catch {set to $email_headers(to)}]} {
set to ""
}
@@ -523,8 +523,8 @@
util_unlist [parse_bounce_address -bounce_address $to] user_id package_id signature
# If no user_id found or signature invalid, ignore message
- if {[empty_string_p $user_id] || ![valid_signature -signature $signature -msg $body]} {
- if {[empty_string_p $user_id]} {
+ if {$user_id eq "" || ![valid_signature -signature $signature -msg $body]} {
+ if {$user_id eq ""} {
ns_log Notice "acs-mail-lite: No user id $user_id found"
} else {
ns_log Notice "acs-mail-lite: Invalid mail signature"
@@ -674,8 +674,8 @@
#-----------------------------------------------------
set delivery_mode [ns_config ns/server/[ns_info server]/acs/acs-rollout-support EmailDeliveryMode]
- if {![empty_string_p $delivery_mode]
- && ![string equal $delivery_mode default]
+ if {$delivery_mode ne ""
+ && $delivery_mode ne "default"
} {
# The to_addr has been put in an array, and returned. Now
# it is of the form: email email_address name namefromdb
@@ -685,10 +685,10 @@
ns_sendmail $to_address $from_addr $subject $body $eh $bcc
} else {
- if { [string equal [bounce_sendmail] "SMTP"] } {
+ if {[bounce_sendmail] eq "SMTP"} {
## Terminate body with a solitary period
foreach line [split $msg "\n"] {
- if {[string match . [string trim $line]]} {
+ if {"." eq [string trim $line]} {
append data .
}
#AG: ensure no \r\r\n terminations.
@@ -698,13 +698,13 @@
append data .
smtp -from_addr $from_addr -sendlist $to_addr -msg $data -valid_email_p $valid_email_p -message_id $message_id -package_id $package_id
- if {![empty_string_p $bcc]} {
+ if {$bcc ne ""} {
smtp -from_addr $from_addr -sendlist $bcc -msg $data -valid_email_p $valid_email_p -message_id $message_id -package_id $package_id
}
} else {
sendmail -from_addr $from_addr -sendlist $to_addr -msg $msg -valid_email_p $valid_email_p -message_id $message_id -package_id $package_id
- if {![empty_string_p $bcc]} {
+ if {$bcc ne ""} {
sendmail -from_addr $from_addr -sendlist $bcc -msg $msg -valid_email_p $valid_email_p -message_id $message_id -package_id $package_id
}
}
@@ -742,7 +742,7 @@
set sendmail [list [bounce_sendmail] "-f[bounce_address -user_id $rcpt_id -package_id $package_id -message_id $message_id]" "-t" "-i"]
# add username if it exists
- if {![empty_string_p $rcpt_name]} {
+ if {$rcpt_name ne ""} {
set pretty_to "$rcpt_name <$rcpt>"
} else {
set pretty_to $rcpt
@@ -765,7 +765,7 @@
ns_log Notice "acs-mail-lite: Email bouncing from $rcpt, mail not sent and deleted from queue"
}
# log mail sending time
- if {![empty_string_p $rcpt_id]} { log_mail_sending -user_id $rcpt_id }
+ if {$rcpt_id ne ""} { log_mail_sending -user_id $rcpt_id }
}
}
}
@@ -791,25 +791,25 @@
(needed to call package-specific code to deal with bounces)
} {
set smtp [ns_config ns/parameters smtphost]
- if {[empty_string_p $smtp]} {
+ if {$smtp eq ""} {
set smtp [ns_config ns/parameters mailhost]
}
- if {[empty_string_p $smtp]} {
+ if {$smtp eq ""} {
set smtp localhost
}
set timeout [ns_config ns/parameters smtptimeout]
- if {[empty_string_p $timeout]} {
+ if {$timeout eq ""} {
set timeout 60
}
set smtpport [ns_config ns/parameters smtpport]
- if {[empty_string_p $smtpport]} {
+ if {$smtpport eq ""} {
set smtpport 25
}
array set rcpts $sendlist
foreach rcpt $rcpts(email) rcpt_id $rcpts(user_id) rcpt_name $rcpts(name) {
if { $valid_email_p || ![bouncing_email_p -email $rcpt] } {
# add username if it exists
- if {![empty_string_p $rcpt_name]} {
+ if {$rcpt_name ne ""} {
set pretty_to "$rcpt_name <$rcpt>"
} else {
set pretty_to $rcpt
@@ -871,7 +871,7 @@
ns_log Notice "acs-mail-lite: Email bouncing from $rcpt, mail not sent and deleted from queue"
}
# log mail sending time
- if {![empty_string_p $rcpt_id]} { log_mail_sending -user_id $rcpt_id }
+ if {$rcpt_id ne ""} { log_mail_sending -user_id $rcpt_id }
}
}
@@ -957,11 +957,11 @@
## Get address-array with email, name and user_id
set to_addr [get_address_array -addresses [string map {\n "" \r ""} $to_addr]]
- if {![empty_string_p $bcc]} {
+ if {$bcc ne ""} {
set bcc [get_address_array -addresses [string map {\n "" \r ""} $bcc]]
}
- if {![empty_string_p $extraheaders]} {
+ if {$extraheaders ne ""} {
set eh_list [util_ns_set_to_list -set $extraheaders]
} else {
set eh_list ""
@@ -973,8 +973,8 @@
set message_id [generate_message_id]
lappend eh_list "Message-Id" $message_id
- if {[empty_string_p $package_id]} {
- if [ad_conn -connected_p] {
+ if {$package_id eq ""} {
+ if {[ad_conn -connected_p]} {
set package_id [ad_conn package_id]
} else {
set package_id ""
Index: openacs-4/packages/acs-mail-lite/tcl/complex-send-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/tcl/Attic/complex-send-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-mail-lite/tcl/complex-send-procs.tcl 8 Jan 2007 13:47:23 -0000 1.6
+++ openacs-4/packages/acs-mail-lite/tcl/complex-send-procs.tcl 10 Jan 2007 21:22:05 -0000 1.7
@@ -234,15 +234,15 @@
} {
set mail_package_id [apm_package_id_from_key "acs-mail-lite"]
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
set package_id $mail_package_id
}
# We check if the parameter
set fixed_sender [parameter::get -parameter "FixedSenderEmail" \
-package_id $mail_package_id]
- if { ![empty_string_p $fixed_sender] && !$use_sender_p} {
+ if { $fixed_sender ne "" && !$use_sender_p} {
set sender_addr $fixed_sender
} else {
set sender_addr $from_addr
@@ -251,13 +251,13 @@
# Get the SMTP Parameters
set smtp [parameter::get -parameter "SMTPHost" \
-package_id $mail_package_id -default [ns_config ns/parameters mailhost]]
- if {[empty_string_p $smtp]} {
+ if {$smtp eq ""} {
set smtp localhost
}
set timeout [parameter::get -parameter "SMTPTimeout" \
-package_id $mail_package_id -default [ns_config ns/parameters smtptimeout]]
- if {[empty_string_p $timeout]} {
+ if {$timeout eq ""} {
set timeout 60
}
@@ -273,7 +273,7 @@
# default values for alternative_part_p
# TRUE on mime_type text/html
# FALSE on mime_type text/plain
- # if { [empty_string_p $alternative_part_p] } { ...}
+ # if { $alternative_part_p eq "" } { ...}
if { $alternative_part_p eq "" } {
if { $mime_type eq "text/plain" } {
set alternative_part_p "0"
@@ -332,7 +332,7 @@
# Check if we are dealing with revisions or items.
foreach file_id $file_ids {
set item_id [content::revision::item_id -revision_id $file_id]
- if {[string eq "" $item_id]} {
+ if {$item_id eq ""} {
lappend item_ids $file_id
} else {
lappend item_ids $item_id
@@ -349,7 +349,7 @@
# Append files from the filesystem
- if {![string eq "" $files]} {
+ if {$files ne ""} {
foreach file $files {
lappend tokens [mime::initialize -param [list name "[ad_quotehtml [lindex $file 0]]"] -canonical [lindex $file 1] -file "[lindex $file 2]"]
}
@@ -515,8 +515,8 @@
# Rollout support (see above for details)
set delivery_mode [ns_config ns/server/[ns_info server]/acs/acs-rollout-support EmailDeliveryMode]
- if {![empty_string_p $delivery_mode]
- && ![string equal $delivery_mode default]
+ if {$delivery_mode ne ""
+ && $delivery_mode ne "default"
} {
set eh [util_list_to_ns_set $extraheaders]
ns_sendmail $to_addr $sender_addr $subject $packaged $eh $bcc_addr
@@ -704,7 +704,7 @@
-alternative_part_p $alternative_part_p \
-use_sender_p $use_sender_p
} errMsg]
- if $err {
+ if {$err} {
ns_log Error "Error while sending queued complex mail: $errMsg"
# release the lock
set locking_server ""
Index: openacs-4/packages/acs-messaging/tcl/acs-messaging-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-messaging/tcl/acs-messaging-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-messaging/tcl/acs-messaging-procs.tcl 11 Sep 2003 07:44:16 -0000 1.4
+++ openacs-4/packages/acs-messaging/tcl/acs-messaging-procs.tcl 10 Jan 2007 21:22:05 -0000 1.5
@@ -23,10 +23,10 @@
of an already-existing OpenACS message.
} {
# empty is okay (handled by notnull)
- if [empty_string_p $value] {
+ if {$value eq ""} {
return 1
}
- if ![acs_message_p $value] {
+ if {![acs_message_p $value]} {
ad_complain "$name ($value) does not refer to a valid OpenACS message"
return 0
}
@@ -43,11 +43,11 @@
@param mime_type MIME content-type of content
@param content Text to view
} {
- if {[string eq $mime_type "text/plain"]} {
+ if {$mime_type eq "text/plain"} {
set result "<pre>[ad_quotehtml $content]</pre>"
- } elseif {[string eq $mime_type "text/plain; format=flowed"]} {
+ } elseif {$mime_type eq "text/plain; format=flowed"} {
set result [ad_text_to_html -- $content]
- } elseif {[string eq $mime_type "text/html"]} {
+ } elseif {$mime_type eq "text/html"} {
set result $content
} else {
set result "<i>content type undecipherable</i>"
@@ -163,17 +163,17 @@
set headers [ns_set create]
ns_set put $headers Sender [ad_parameter "OutgoingSender" "acs-kernel"]
- if ![string equal $in_reply_to ""] {
+ if {$in_reply_to ne "" } {
ns_set put $headers In-Reply-To "<$in_reply_to>"
}
ns_set put $headers Message-ID "<$rfc822_id>"
ns_set put $headers Date "$sent_date [acs_messaging_timezone_offset]"
ns_set put $headers MIME-Version "1.0"
ns_set put $headers Content-Type $mime_type
ns_log "Notice" "About to send"
- if ![catch {
+ if {![catch {
ns_sendmail $recip_email $sender_email $title $content $headers
- } errMsg] {
+ } errMsg]} {
ns_log "Notice" "Sending"
# everything went well, dequeue
db_dml acs_message_remove_from_queue {
Index: openacs-4/packages/acs-service-contract/tcl/acs-service-contract-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/acs-service-contract-procs.tcl,v
diff -u -r1.22 -r1.23
--- openacs-4/packages/acs-service-contract/tcl/acs-service-contract-procs.tcl 20 Apr 2004 21:12:55 -0000 1.22
+++ openacs-4/packages/acs-service-contract/tcl/acs-service-contract-procs.tcl 10 Jan 2007 21:22:05 -0000 1.23
@@ -44,7 +44,7 @@
}
acs_sc::impl::get -impl_id $impl_id -array impl_info
set impl $impl_info(impl_name)
- if { ![empty_string_p $contract] && ![string equal $contract $impl_info(impl_contract_name)] } {
+ if { $contract ne "" && $contract ne $impl_info(impl_contract_name) } {
error "The contract of implementation with id $impl_id does not match contract passed in. Expected contract to be '$contract', but contract of impl_id was '$impl_info(impl_contract_name)'"
}
set contract $impl_info(impl_contract_name)
@@ -110,7 +110,7 @@
#set exists_p [util_memoize "acs_sc_binding_exists_p $contract $impl"]
- if ![set exists_p] {return ""}
+ if {![set exists_p]} {return ""}
db_0or1row get_alias {*SQL*}
@@ -141,11 +141,11 @@
acs_sc_log SCDebug "ACS_SC_PROC: proc_name = $proc_name"
- if { [empty_string_p $impl_alias] } {
+ if { $impl_alias eq "" } {
foreach {impl_alias impl_pl} [acs_sc_get_alias $contract $operation $impl] break
}
- if { [empty_string_p $impl_alias] } {
+ if { $impl_alias eq "" } {
error "ACS-SC: Cannot find alias for $proc_name"
}
@@ -274,7 +274,7 @@
# Private logging proc
proc acs_sc_log {level msg} {
# If you want to debug the SC, uncomment the Debug log below
- if { ![string equal "SCDebug" $level] } {
+ if { "SCDebug" ne $level } {
ns_log $level "$msg"
} else {
# ns_log Debug "$msg"
Index: openacs-4/packages/acs-service-contract/tcl/contract-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/contract-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-service-contract/tcl/contract-procs.tcl 3 Sep 2003 19:51:06 -0000 1.4
+++ openacs-4/packages/acs-service-contract/tcl/contract-procs.tcl 10 Jan 2007 21:22:05 -0000 1.5
@@ -174,7 +174,7 @@
# Delete msg types
foreach msg_type_id $msg_types {
- if { ![empty_string_p $msg_type_id] } {
+ if { $msg_type_id ne "" } {
acs_sc::msg_type::delete -msg_type_id $msg_type_id
}
}
Index: openacs-4/packages/acs-service-contract/tcl/implementation-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/tcl/implementation-procs.tcl,v
diff -u -r1.12 -r1.13
--- openacs-4/packages/acs-service-contract/tcl/implementation-procs.tcl 14 Jul 2006 00:43:38 -0000 1.12
+++ openacs-4/packages/acs-service-contract/tcl/implementation-procs.tcl 10 Jan 2007 21:22:05 -0000 1.13
@@ -32,7 +32,7 @@
@return the ID of the new implementation
} {
- if { [empty_string_p $pretty_name] } {
+ if { $pretty_name eq "" } {
set pretty_name $name
}
return [db_exec_plsql impl_new {}]
@@ -196,7 +196,7 @@
set impl_list [list]
- if { ![empty_string_p $empty_label] } {
+ if { $empty_label ne "" } {
lappend impl_list [list $empty_label ""]
}
Index: openacs-4/packages/acs-service-contract/www/binding-display.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-service-contract/www/binding-display.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-service-contract/www/binding-display.tcl 8 Feb 2005 01:16:49 -0000 1.1
+++ openacs-4/packages/acs-service-contract/www/binding-display.tcl 10 Jan 2007 21:22:05 -0000 1.2
@@ -48,7 +48,7 @@
order by lower(impl_operation_name)
} {
- if {[string equal $impl_pl "TCL"]} {
+ if {$impl_pl eq "TCL"} {
regsub {^::} $impl_alias {} impl_alias
if {[empty_string_p [info proc ::$impl_alias]]} {
append impl_alias {</b> - <b style="color: red">NOT FOUND!</b>}
Index: openacs-4/packages/acs-subsite/lib/login.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/lib/login.tcl,v
diff -u -r1.27 -r1.28
--- openacs-4/packages/acs-subsite/lib/login.tcl 5 Dec 2006 18:56:34 -0000 1.27
+++ openacs-4/packages/acs-subsite/lib/login.tcl 10 Jan 2007 21:22:05 -0000 1.28
@@ -36,7 +36,7 @@
set email {}
}
-if { [empty_string_p $email] && [empty_string_p $username] && [ad_conn untrusted_user_id] != 0 } {
+if { $email eq "" && $username eq "" && [ad_conn untrusted_user_id] != 0 } {
acs_user::get -user_id [ad_conn untrusted_user_id] -array untrusted_user
if { [auth::UseEmailForLoginP] } {
set email $untrusted_user(email)
@@ -86,7 +86,7 @@
set forgotten_pwd_url [auth::password::get_forgotten_url -authority_id $authority_id -username $username -email $email]
set register_url [export_vars -base "[subsite::get_url]register/user-new" { return_url }]
-if { [string equal $authority_id [auth::get_register_authority]] || [auth::UseEmailForLoginP] } {
+if { $authority_id eq [auth::get_register_authority] || [auth::UseEmailForLoginP] } {
set register_url [export_vars -no_empty -base $register_url { username email }]
}
@@ -107,7 +107,7 @@
if { [auth::UseEmailForLoginP] } {
ad_form -extend -name login -form [list [list email:text($username_widget),nospell [list label [_ acs-subsite.Email]] [list html [list style "width: 150px"]]]]
set user_id_widget_name email
- if { ![empty_string_p $email] } {
+ if { $email ne "" } {
set focus "password"
} else {
set focus "email"
@@ -124,7 +124,7 @@
ad_form -extend -name login -form [list [list username:text($username_widget),nospell [list label [_ acs-subsite.Username]] [list html [list style "width: 150px"]]]]
set user_id_widget_name username
- if { ![empty_string_p $username] } {
+ if { $username ne "" } {
set focus "password"
} else {
set focus "username"
@@ -177,7 +177,7 @@
set expiration_time 30
}
- if { [string compare $hash $computed_hash] != 0 || \
+ if { $hash ne $computed_hash || \
$time < [ns_time] - $expiration_time } {
ad_returnredirect -message [_ acs-subsite.Login_has_expired] -- [export_vars -base [ad_conn url] { return_url }]
ad_script_abort
@@ -198,7 +198,7 @@
-email [string trim $email] \
-username [string trim $username] \
-password $password \
- -persistent=[expr $allow_persistent_login_p && [template::util::is_true $persistent_p]]]
+ -persistent=[expr {$allow_persistent_login_p && [template::util::is_true $persistent_p]}]]
# Handle authentication problems
switch $auth_info(auth_status) {
Index: openacs-4/packages/acs-subsite/lib/services.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/lib/Attic/services.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/lib/services.tcl 22 Dec 2003 21:59:39 -0000 1.3
+++ openacs-4/packages/acs-subsite/lib/services.tcl 10 Jan 2007 21:22:05 -0000 1.4
@@ -17,7 +17,7 @@
array unset node
array set node [site_node::get_from_url -url $url -exact]
- if { ![string equal $node(package_key) "acs-subsite"] && [permission::permission_p -object_id $node(object_id) -privilege read] } {
+ if { $node(package_key) ne "acs-subsite" && [permission::permission_p -object_id $node(object_id) -privilege read] } {
lappend services [list \
$node(instance_name) \
$node(node_id) \
Index: openacs-4/packages/acs-subsite/lib/user-info.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/lib/user-info.tcl,v
diff -u -r1.16 -r1.17
--- openacs-4/packages/acs-subsite/lib/user-info.tcl 11 Jun 2005 14:14:37 -0000 1.16
+++ openacs-4/packages/acs-subsite/lib/user-info.tcl 10 Jan 2007 21:22:05 -0000 1.17
@@ -33,7 +33,7 @@
set elm_mode($elm) {}
}
set read_only_elements [auth::sync::get_sync_elements -authority_id $user(authority_id)]
-set read_only_notice_p [expr [llength $read_only_elements] > 0]
+set read_only_notice_p [expr {[llength $read_only_elements] > 0}]
if { ![acs_user::site_wide_admin_p] } {
lappend read_only_elements authority_id username
}
@@ -42,7 +42,7 @@
}
set first_element {}
foreach elm $form_elms {
- if { [empty_string_p $elm_mode($elm)] && (![string equal $elm "username"] && [auth::UseEmailForLoginP]) } {
+ if { $elm_mode($elm) eq "" && ($elm ne "username" && [auth::UseEmailForLoginP]) } {
set first_element $elm
break
}
@@ -101,7 +101,7 @@
}
}
-if { ![string equal [acs_user::ScreenName] "none"] } {
+if { [acs_user::ScreenName] ne "none" } {
ad_form -extend -name user_info -form \
[list \
[list screen_name:text[ad_decode [acs_user::ScreenName] "solicit" ",optional" ""] \
@@ -159,7 +159,7 @@
set user_info(authority_id) $user(authority_id)
set user_info(username) $user(username)
foreach elm $form_elms {
- if { [empty_string_p $elm_mode($elm)] && [info exists $elm] } {
+ if { $elm_mode($elm) eq "" && [info exists $elm] } {
set user_info($elm) [string trim [set $elm]]
}
}
@@ -207,7 +207,7 @@
}
} -after_submit {
- if { [string equal [ad_conn account_status] "closed"] } {
+ if {[ad_conn account_status] eq "closed"} {
auth::verify_account_status
}
Index: openacs-4/packages/acs-subsite/lib/user-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/lib/user-new.tcl,v
diff -u -r1.16 -r1.17
--- openacs-4/packages/acs-subsite/lib/user-new.tcl 15 Dec 2006 00:01:52 -0000 1.16
+++ openacs-4/packages/acs-subsite/lib/user-new.tcl 10 Jan 2007 21:22:05 -0000 1.17
@@ -55,7 +55,7 @@
ad_form -name register -export {next_url user_id return_url} -form [auth::get_registration_form_elements] -validate {
{email
- {[string eq "" [party::get_by_email -email $email]]}
+ {[string equal "" [party::get_by_email -email $email]]}
"[_ acs-subsite.Email_already_exists]"
}
}
@@ -101,7 +101,7 @@
-secret_question $secret_question \
-secret_answer $secret_answer]
- if { [string equal $creation_info(creation_status) "ok"] && [exists_and_not_null rel_group_id] } {
+ if { $creation_info(creation_status) eq "ok" && [exists_and_not_null rel_group_id] } {
group::add_member \
-group_id $rel_group_id \
-user_id $user_id \
@@ -144,7 +144,7 @@
} -after_submit {
- if { ![empty_string_p $next_url] } {
+ if { $next_url ne "" } {
# Add user_id and account_message to the URL
ad_returnredirect [export_vars -base $next_url {user_id password {account_message $creation_info(account_message)}}]
@@ -166,14 +166,14 @@
# lang::user::locale, as we are now a registered user,
# but one without a valid locale setting.
set locale [ad_get_cookie "ad_locale"]
- if { ![empty_string_p $locale] } {
+ if { $locale ne "" } {
lang::user::set_locale $locale
ad_set_cookie -replace t -max_age 0 "ad_locale" ""
}
}
# Handle account_message
- if { ![empty_string_p $creation_info(account_message)] && $self_register_p } {
+ if { $creation_info(account_message) ne "" && $self_register_p } {
# Only do this if user is self-registering
# as opposed to creating an account for someone else
ad_returnredirect [export_vars -base "[subsite::get_element -element url]register/account-message" { { message $creation_info(account_message) } return_url }]
Index: openacs-4/packages/acs-subsite/tcl/apm-callback-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/apm-callback-procs.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-subsite/tcl/apm-callback-procs.tcl 15 Dec 2006 00:01:53 -0000 1.9
+++ openacs-4/packages/acs-subsite/tcl/apm-callback-procs.tcl 10 Jan 2007 21:22:06 -0000 1.10
@@ -38,19 +38,19 @@
}
5.2.0a1 5.2.0a2 {
set value [parameter::get -parameter "AsmForRegisterId" -package_id [subsite::main_site_id]]
- if {[empty_string_p $value]} {
+ if {$value eq ""} {
apm_parameter_register "AsmForRegisterId" "Assessment used on the registration process." "acs-subsite" "0" "number" "user-login"
}
apm_parameter_register "RegImplName" "Name of the implementation used in the registration process" "acs-subsite" "asm_url" "string" "user-login"
}
5.2.0a1 5.2.0a2 {
set value [parameter::get -parameter "RegistrationId" -package_id [subsite::main_site_id]]
- if {[empty_string_p $value]} {
+ if {$value eq ""} {
apm_parameter_register "RegistrationId" "Assessment used on the registration process." "acs-subsite" "0" "number" "user-login"
}
set value [parameter::get -parameter "RegistrationId" -package_id [subsite::main_site_id]]
- if {[empty_string_p $value]} {
+ if {$value eq ""} {
apm_parameter_register "RegistrationImplName" "Name of the implementation used in the registration process" "acs-subsite" "asm_url" "string" "user-login"
}
}
@@ -69,11 +69,11 @@
}
5.2.0a1 5.2.0a2 {
set value [parameter::get -parameter "RegistrationId" -package_id [subsite::main_site_id]]
- if {[empty_string_p $value]} {
+ if {$value eq ""} {
apm_parameter_register "RegistrationId" "Assessment used on the registration process." "acs-subsite" "0" "number" "user-login"
}
set value [parameter::get -parameter "RegistrationId" -package_id [subsite::main_site_id]]
- if {[empty_string_p $value]} {
+ if {$value eq ""} {
apm_parameter_register "RegistrationImplName" "Name of the implementation used in the registration process" "acs-subsite" "asm_url" "string" "user-login"
}
}
Index: openacs-4/packages/acs-subsite/tcl/application-group-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/application-group-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-subsite/tcl/application-group-procs.tcl 27 Feb 2005 20:05:59 -0000 1.6
+++ openacs-4/packages/acs-subsite/tcl/application-group-procs.tcl 10 Jan 2007 21:22:06 -0000 1.7
@@ -25,11 +25,11 @@
} {
- if {[empty_string_p $package_id] && [ad_conn isconnected]} {
+ if {$package_id eq "" && [ad_conn isconnected]} {
set package_id [ad_conn package_id]
}
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
error "application_group::contains_party_p - package_id not specified"
}
@@ -79,11 +79,11 @@
[ad_conn package_id]).
} {
- if {[empty_string_p $package_id] && [ad_conn isconnected]} {
+ if {$package_id eq "" && [ad_conn isconnected]} {
set package_id [ad_conn package_id]
}
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
error "application_group::contains_party_p - package_id not specified"
}
@@ -115,11 +115,11 @@
} {
- if {[empty_string_p $package_id] && [ad_conn isconnected]} {
+ if {$package_id eq "" && [ad_conn isconnected]} {
set package_id [ad_conn package_id]
}
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
error "application_group::contains_segment_p - package_id not specified"
}
@@ -157,12 +157,12 @@
}
if { [ad_conn isconnected] } {
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
set package_id [ad_conn package_id]
}
}
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
error "application_group::group_id_from_package_id - no package_id specified."
}
@@ -197,22 +197,22 @@
if { [ad_conn isconnected] } {
# Since we have a connection, default user_id / peeraddr
# if they're not specified
- if { [empty_string_p $creation_user] } {
+ if { $creation_user eq "" } {
set creation_user [ad_conn user_id]
}
- if { [empty_string_p $creation_ip] } {
+ if { $creation_ip eq "" } {
set creation_ip [ad_conn peeraddr]
}
- if { [empty_string_p $package_id] } {
+ if { $package_id eq "" } {
set package_id [ad_conn package_id]
}
}
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
error "application_group::new - package_id not specified"
}
- if {[empty_string_p $group_name]} {
+ if {$group_name eq ""} {
set group_name [db_string group_name_query {
select substr(instance_name, 1, 90)
from apm_packages
Index: openacs-4/packages/acs-subsite/tcl/attribute-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/attribute-procs.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-subsite/tcl/attribute-procs.tcl 27 Jul 2006 00:42:52 -0000 1.8
+++ openacs-4/packages/acs-subsite/tcl/attribute-procs.tcl 10 Jan 2007 21:22:06 -0000 1.9
@@ -59,7 +59,7 @@
specified name. 0 otherwise
} {
- if { $convert_p == "t" } {
+ if { $convert_p eq "t" } {
set attribute [plsql_utility::generate_oracle_name $orig_attribute]
} else {
set attribute $orig_attribute
@@ -77,7 +77,7 @@
from dual
}]
- if { $attr_exists_p || $convert_p == "f" } {
+ if { $attr_exists_p || $convert_p eq "f" } {
# If the attribute exists, o
return $attr_exists_p
}
@@ -153,7 +153,7 @@
# execute drop statements until we reach position $i+1
# This position represents the operation on which we failed, and thus
# is not executed
- for { set inner [expr [llength $plsql_drop] - 1] } { $inner > [expr $i + 1] } { set inner [expr $inner - 1] } {
+ for { set inner [expr {[llength $plsql_drop] - 1}] } { $inner > [expr {$i + 1}] } { set inner [expr {$inner - 1}] } {
set drop_pair [lindex $plsql_drop $inner]
if { [catch {eval [lindex $drop_pair 2] [lindex $drop_pair 0] [lindex $drop_pair 1]} err_msg_2] } {
append err_msg "\nAdditional error while trying to roll back: $err_msg_2"
@@ -210,7 +210,7 @@
set sql "$type"
- if { ![empty_string_p $default] } {
+ if { $default ne "" } {
# This is also pretty nasty - we have to make sure we
# treat db literals appropriately - null is much different
# than 'null' - mbryzek
@@ -220,7 +220,7 @@
}
append sql " default $default"
}
- if { ![empty_string_p $constraint] } {
+ if { $constraint ne "" } {
append sql " constraint $constraint"
}
return $sql
@@ -252,7 +252,7 @@
# Attribute doesn't exist
return 0
}
- if { [empty_string_p $table_name] || [empty_string_p $column_name] } {
+ if { $table_name eq "" || $column_name eq "" } {
# We have to have both a non-empty table name and column name
error "We do not have enough information to automatically remove this attribute. Namely, we are missing either the table name or the column name"
}
@@ -379,10 +379,10 @@
@creation-date 12/2000
} {
- if { [string eq $datatype "date"] } {
+ if {$datatype eq "date"} {
return 0
}
- if { [string eq $datatype "enumeration"] } {
+ if {$datatype eq "enumeration"} {
return 1
}
if { [empty_string_p [info procs "::template::data::validate::$datatype"]] } {
@@ -437,7 +437,7 @@
set storage_clause ""
- if {![empty_string_p $include_storage_types]} {
+ if {$include_storage_types ne ""} {
set storage_clause "
and a.storage in ('[join $include_storage_types "', '"]')"
}
@@ -464,7 +464,7 @@
set attr_props(datatype:$name) $datatype
set attr_props(id:$name) $attribute_id
}
- if { [string eq $datatype "enumeration"] } {
+ if {$datatype eq "enumeration"} {
set enum_values($name:$enum_value) $value_pretty_name
}
}
@@ -487,13 +487,13 @@
upvar $datasource_name attributes
- if {[empty_string_p $object_type]} {
+ if {$object_type eq ""} {
set object_type [db_string object_type_query {
select object_type from acs_objects where object_id = :object_id
}]
}
- if {[empty_string_p $return_url]} {
+ if {$return_url eq ""} {
set return_url "[ad_conn url]?[ad_conn query]"
}
@@ -519,7 +519,7 @@
foreach key $attr_list {
set col_value [set $key]
set attribute_id $attr_props(id:$key)
- if { [string eq $attr_props(datatype:$key) "enumeration"] && [info exists enum_values($key:$col_value)] } {
+ if { $attr_props(datatype:$key) eq "enumeration" && [info exists enum_values($key:$col_value)] } {
# Replace the value stored in the column with the
# pretty name for that attribute
set col_value $enum_values($key:$col_value)
@@ -546,15 +546,15 @@
@param variable_prefix Variable prefix.
} {
- if {[empty_string_p $form_id]} {
+ if {$form_id eq ""} {
error "attribute::add_form_elements - form_id not specified"
}
- if {[empty_string_p $object_type]} {
+ if {$object_type eq ""} {
error "attribute::add_form_elements - object type not specified"
}
- if {![empty_string_p $variable_prefix]} {
+ if {$variable_prefix ne ""} {
append variable_prefix "."
}
@@ -572,15 +572,15 @@
set required_p [lindex $row 5]
set default [lindex $row 6]
- if { [string eq $datatype "enumeration"] } {
+ if {$datatype eq "enumeration"} {
# For enumerations, we generate a select box of all the possible values
set option_list [db_list_of_lists select_enum_values {
select enum.pretty_name, enum.enum_value
from acs_enum_values enum
where enum.attribute_id = :attribute_id
order by enum.sort_order
}]
- if { [string eq $required_p "f"] } {
+ if {$required_p eq "f"} {
# This is not a required option list... offer a default
lappend option_list [list " (no value) " ""]
}
Index: openacs-4/packages/acs-subsite/tcl/email-image-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/email-image-procs.tcl,v
diff -u -r1.7 -r1.8
--- openacs-4/packages/acs-subsite/tcl/email-image-procs.tcl 19 Jul 2006 10:07:39 -0000 1.7
+++ openacs-4/packages/acs-subsite/tcl/email-image-procs.tcl 10 Jan 2007 21:22:06 -0000 1.8
@@ -132,12 +132,12 @@
set image_name "email${user_id}.gif"
set email_length [string length $email]
set dest_path "/tmp/$image_name"
- set width [expr [expr $email_length * [expr $font_size / 2]] + 2]
+ set width [expr [expr {$email_length * [expr {$font_size / 2}]}] + 2]
set height $font_size
- set ypos [expr [expr $height / 2] + 3 ]
+ set ypos [expr {[expr {$height / 2}] + 3 }]
set size "${width}x$height"
- if { [string equal $bgcolor ""]} {
+ if {$bgcolor eq ""} {
set bgcolor "\#ffffff"
}
@@ -150,7 +150,7 @@
exec convert -font $font_type -fill blue -pointsize $font_size -draw "text 0,$ypos $email" \
$dest_path $dest_path
- if { [string equal $transparent ""] || [string equal $transparent "1"] } {
+ if { $transparent eq "" || $transparent eq "1" } {
# Making the bg color transparent
exec convert $dest_path -transparent $bgcolor $dest_path
}
@@ -210,12 +210,12 @@
set image_name "email${user_id}.gif"
set email_length [string length $new_email]
set dest_path "/tmp/$image_name"
- set width [expr [expr $email_length * [expr $font_size / 2]] + 2]
+ set width [expr [expr {$email_length * [expr {$font_size / 2}]}] + 2]
set height $font_size
- set ypos [expr [expr $height / 2] + 3 ]
+ set ypos [expr {[expr {$height / 2}] + 3 }]
set size "${width}x$height"
- if { [string equal $bgcolor ""]} {
+ if {$bgcolor eq ""} {
set bgcolor "\#ffffff"
}
@@ -231,7 +231,7 @@
exec convert -font $font_type -fill blue -pointsize $font_size -draw "text 0,$ypos $new_email" \
$dest_path $dest_path
- if { [string equal $transparent ""] || [string equal $transparent "1"] } {
+ if { $transparent eq "" || $transparent eq "1" } {
# Making the bg color transparent
exec convert $dest_path -transparent $bgcolor $dest_path
}
Index: openacs-4/packages/acs-subsite/tcl/group-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/group-procs.tcl,v
diff -u -r1.29 -r1.30
--- openacs-4/packages/acs-subsite/tcl/group-procs.tcl 19 Dec 2006 09:05:18 -0000 1.29
+++ openacs-4/packages/acs-subsite/tcl/group-procs.tcl 10 Jan 2007 21:22:06 -0000 1.30
@@ -104,10 +104,10 @@
set var_list [list]
lappend var_list [list context_id $context_id]
lappend var_list [list $id_column $group_id]
- if { ![empty_string_p $group_name] } {
+ if { $group_name ne "" } {
set group_name [lang::util::convert_to_i18n -prefix "group" -text "$group_name"]
lappend var_list [list group_name $group_name]
- if {[empty_string_p $pretty_name]} {
+ if {$pretty_name eq ""} {
set pretty_name $group_name
}
}
@@ -133,7 +133,7 @@
}
# Update the title to the pretty name
- if {![empty_string_p $pretty_name]} {
+ if {$pretty_name ne ""} {
db_dml title_update "update acs_objects set title=:pretty_name where object_id = :group_id"
}
return $group_id
@@ -467,11 +467,11 @@
@param create_p - 1 if the user has 'create' privilege on the group,
0 otherwise.
} {
- if {$create_p || [string equal $join_policy open]} {
+ if {$create_p || $join_policy eq "open"} {
return "approved"
}
- if {[string equal $join_policy "needs approval"]} {
+ if {$join_policy eq "needs approval"} {
return "needs approval"
}
@@ -508,17 +508,17 @@
} {
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
set user_id [ad_conn user_id]
}
- if { [empty_string_p $group_name] && [empty_string_p $group_id] } {
+ if { $group_name eq "" && $group_id eq "" } {
return 0
}
- if { ![empty_string_p $group_name] } {
+ if { $group_name ne "" } {
set group_id [group::get_id -group_name $group_name -subsite_id $subsite_id]
- if { [empty_string_p $group_id] } {
+ if { $group_id eq "" } {
return 0
}
}
@@ -574,13 +574,13 @@
} {
- if { [empty_string_p $group_name] && [empty_string_p $group_id] } {
+ if { $group_name eq "" && $group_id eq "" } {
return 0
}
- if { ![empty_string_p $group_name] } {
+ if { $group_name ne "" } {
set group_id [group::get_id -group_name $group_name -subsite_id $subsite_id]
- if { [empty_string_p $group_id] } {
+ if { $group_id eq "" } {
return 0
}
}
@@ -633,7 +633,7 @@
-rel_type "admin_rel"]
# The party is an admin if the call above returned something non-empty
- return [expr ![empty_string_p $admin_rel_id]]
+ return [expr {$admin_rel_id ne ""}]
}
@@ -650,8 +650,8 @@
set admin_p [permission::permission_p -object_id $group_id -privilege "admin"]
# Only admins can add non-membership_rel members
- if { [empty_string_p $rel_type] || \
- (!$no_perm_check_p && ![empty_string_p $rel_type] && ![string equal $rel_type "membership_rel"] && \
+ if { $rel_type eq "" || \
+ (!$no_perm_check_p && $rel_type ne "" && $rel_type ne "membership_rel" && \
![permission::permission_p -object_id $group_id -privilege "admin"]) } {
set rel_type "membership_rel"
}
@@ -660,20 +660,20 @@
if { !$no_perm_check_p } {
set create_p [group::permission_p -privilege create $group_id]
- if { [string equal $group(join_policy) "closed"] && !$create_p } {
+ if { $group(join_policy) eq "closed" && !$create_p } {
error "You do not have permission to add members to the group '$group(group_name)'"
}
} else {
set create_p 1
}
- if { [empty_string_p $member_state] } {
+ if { $member_state eq "" } {
set member_state [group::default_member_state \
-join_policy $group(join_policy) \
-create_p $create_p]
}
- if { ![string equal $rel_type "membership_rel"] } {
+ if { $rel_type ne "membership_rel" } {
# Add them with a membership_rel first
relation_add -member_state $member_state "membership_rel" $group_id $user_id
}
@@ -722,11 +722,11 @@
@param group_id The group_id of the group
@param group_name The name of the group. Note this is not the I18N title we want to retrieve with this procedure
} {
- if {![empty_string_p $group_name]} {
+ if {$group_name ne ""} {
set group_id [group::get_id -group_name $group_name]
}
- if {![empty_string_p $group_id]} {
+ if {$group_id ne ""} {
return [util_memoize [list group::title_not_cached -group_id $group_id]]
} else {
return ""
Index: openacs-4/packages/acs-subsite/tcl/group-type-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/group-type-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-subsite/tcl/group-type-procs.tcl 20 Apr 2004 21:12:58 -0000 1.4
+++ openacs-4/packages/acs-subsite/tcl/group-type-procs.tcl 10 Jan 2007 21:22:06 -0000 1.5
@@ -25,7 +25,7 @@
@creation-date 12/2000
} {
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
if { ![ad_conn isconnected] } {
error "group_type::drop_all_groups_p: User ID not specified and we have no connection from which to obtain current user ID.\n"
}
@@ -71,10 +71,10 @@
@return the <code>group_type</code> of the object created
} {
- if { [empty_string_p $group_type] } {
+ if { $group_type eq "" } {
# generate a unique group type name. Note that we expect
# the while loop to finish immediately
- while { [empty_string_p $group_type] || [plsql_utility::object_type_exists_p $group_type] } {
+ while { $group_type eq "" || [plsql_utility::object_type_exists_p $group_type] } {
set group_type "GROUP_[db_nextval "acs_object_id_seq"]"
}
} else {
@@ -136,14 +136,14 @@
lappend plsql_drop [list remove_rel_types "delete from group_type_rels where group_type = :group_type"]
lappend plsql [list copy_rel_types [db_map copy_rel_types]]
- if { $execute_p == "f" } {
+ if { $execute_p eq "f" } {
set text "-- Create script"
foreach pair $plsql {
append text "[plsql_utility::parse_sql [lindex $pair 1]]\n\n"
}
# Now add the drop script
append text "-- Drop script\n";
- for { set i [expr [llength $plsql_drop] - 1] } { $i >= 0 } { set i [expr $i - 1] } {
+ for { set i [expr {[llength $plsql_drop] - 1}] } { $i >= 0 } { set i [expr {$i - 1}] } {
# Don't need the sql keys when we display debugging information
append text "-- [lindex [lindex $plsql_drop $i] 1]\n\n"
}
@@ -164,7 +164,7 @@
references $references_table ($references_column)
)"} errmsg] } {
# Roll back our work so for
- for { set i [expr [llength $plsql_drop] - 1] } { $i >= 0 } { incr i -1 } {
+ for { set i [expr {[llength $plsql_drop] - 1}] } { $i >= 0 } { incr i -1 } {
set pair [lindex $plsql_drop $i]
if { [catch {db_exec_plsql [lindex $drop_pair 0] [lindex $drop_pair 1]} err_msg_2] } {
append errmsg "\nAdditional error while trying to roll back: $err_msg_2"
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.22 -r1.23
--- openacs-4/packages/acs-subsite/tcl/package-procs.tcl 18 Jan 2005 17:06:36 -0000 1.22
+++ openacs-4/packages/acs-subsite/tcl/package-procs.tcl 10 Jan 2007 21:22:06 -0000 1.23
@@ -75,7 +75,7 @@
attributes
} {
- if { [empty_string_p $table] || [empty_string_p $column] } {
+ if { $table eq "" || $column eq "" } {
# pull out the table and column names based on the object type
db_1row select_type_info {
select t.table_name as table, t.id_column as column
@@ -103,7 +103,7 @@
# duplicate column names
set all_attributes([string toupper $column]) 1
- if { ![empty_string_p $column_value] } {
+ if { $column_value ne "" } {
# column value is the same physical column as $column - just
# named differently in the attribute list. We still don't want
# duplicates
@@ -128,7 +128,7 @@
order by t.type_level
} {
# First make sure the attribute is okay
- if { ![empty_string_p $limit_to] } {
+ if { $limit_to ne "" } {
# We have a limited list of arguments to use. Make sure
# this attribute is one of them
if { [lsearch -exact $limit_to $attr_column_name] == -1 } {
@@ -145,7 +145,7 @@
set all_attributes($attr_column_name) 1
}
- if { ![empty_string_p $supertype] && ![empty_string_p $object_name] } {
+ if { $supertype ne "" && $object_name ne "" } {
foreach row [util_memoize "package_table_columns_for_type \"$supertype\""] {
set table_name [lindex $row 0]
set column_name [lindex $row 1]
@@ -200,15 +200,15 @@
# We handle defaults grossly here, but I don't currently have
# a better idea how to do this
- if { ![empty_string_p $attr_default] } {
+ if { $attr_default ne "" } {
return "'[DoubleApos $attr_default]'"
}
# Special cases for acs_object and acs_rels
# attributes. Default case sets default to null unless the
# attribute is required (min_n_values > 0)
- if { [string equal $table "ACS_OBJECTS"] } {
+ if {$table eq "ACS_OBJECTS"} {
switch -- $column {
"OBJECT_TYPE" { return "'[DoubleApos $object_type]'" }
"CREATION_DATE" { return [db_map creation_date] }
@@ -217,7 +217,7 @@
"LAST_MODIFIED" { return [db_map last_modified] }
"MODIFYING_IP" { return "NULL" }
}
- } elseif { [string equal $table "ACS_RELS"] } {
+ } elseif {$table eq "ACS_RELS"} {
switch -- $column {
"REL_TYPE" { return "'[DoubleApos $object_type]'" }
}
@@ -312,7 +312,7 @@
lappend plsql [list "package" "create_package" [package_generate_spec $object_type]]
lappend plsql [list "package body" "create_package_body" [package_generate_body $object_type]]
- if { $debug_p == "t" } {
+ if { $debug_p eq "t" } {
foreach pair $plsql {
# append text "[plsql_utility::parse_sql [lindex $pair 1]]\n\n"
append text [lindex $pair 2]
@@ -475,7 +475,7 @@
@param start_with The highest parent object type for which to include attributes
@param object_type The object for which to create a package spec
} {
- if { [string eq $refresh_p "t"] } {
+ if {$refresh_p eq "t"} {
package_object_view_reset $object_type
}
return [util_memoize "package_object_view_helper -start_with $start_with $object_type"]
@@ -510,7 +510,7 @@
set columns [list "${table_name}.${id_column}"]
- if { ![string eq [string tolower $id_column] "object_id"] } {
+ if { [string tolower $id_column] ne "object_id" } {
# Add in an alias for object_id
lappend columns "${table_name}.${id_column} as object_id"
}
@@ -522,7 +522,7 @@
set column [lindex $row 2]
set object_column [lindex $row 8]
- if { [string eq [string tolower $column] "object_id"] } {
+ if {[string tolower $column] eq "object_id"} {
# We already have object_id... skip this column
continue
}
@@ -544,8 +544,8 @@
}
set pk_formatted [list]
- for { set i 0 } { $i < [expr [llength $primary_keys] - 1] } { incr i } {
- lappend pk_formatted "[lindex $primary_keys $i] = [lindex $primary_keys [expr $i +1]]"
+ for { set i 0 } { $i < [expr {[llength $primary_keys] - 1}] } { incr i } {
+ lappend pk_formatted "[lindex $primary_keys $i] = [lindex $primary_keys [expr {$i +1}]]"
}
return "SELECT [string tolower [join $columns ",\n "]]
FROM [string tolower [join $tables ", "]]
@@ -606,7 +606,7 @@
set storage_clause ""
- if {![empty_string_p $include_storage_types]} {
+ if {$include_storage_types ne ""} {
set storage_clause "
and a.storage in ('[join $include_storage_types "', '"]')"
}
@@ -789,12 +789,12 @@
} {
- if {![empty_string_p $variable_prefix]} {
+ if {$variable_prefix ne ""} {
append variable_prefix "."
}
# Select out the package name if it wasn't passed in
- if { [empty_string_p $package_name] } {
+ if { $package_name eq "" } {
if { ![db_0or1row package_select {
select t.package_name
from acs_object_types t
@@ -805,10 +805,10 @@
}
if { [ad_conn isconnected] } {
- if { [empty_string_p $creation_user] } {
+ if { $creation_user eq "" } {
set creation_user [ad_conn user_id]
}
- if { [empty_string_p $creation_ip] } {
+ if { $creation_ip eq "" } {
set creation_ip [ad_conn peeraddr]
}
}
@@ -854,7 +854,7 @@
}
# Go through the extra_vars (ben - OpenACS)
- if {! [empty_string_p $extra_vars] } {
+ if {$extra_vars ne "" } {
for {set i 0} {$i < [ns_set size $extra_vars]} {incr i} {
set __key [ns_set key $extra_vars $i]
set __value [ns_set value $extra_vars $i]
@@ -872,7 +872,7 @@
}
- if { ![empty_string_p $form_id]} {
+ if { $form_id ne ""} {
#DRB: This needs to be cached!
set __id_column [db_string get_id_column {}]
@@ -882,7 +882,7 @@
lappend pieces [list $__id_column]
}
- if { [string equal $start_with ""] } {
+ if {$start_with eq ""} {
set start_with $object_type
}
Index: openacs-4/packages/acs-subsite/tcl/party-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/Attic/party-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/tcl/party-procs.tcl 4 Jun 2006 00:45:42 -0000 1.3
+++ openacs-4/packages/acs-subsite/tcl/party-procs.tcl 10 Jan 2007 21:22:06 -0000 1.4
@@ -168,7 +168,7 @@
# Special case "party" because we don't want to display "party" itself
# as an option, and we don't want to display "rel_segment" as an
# option.
- if {[string equal $start_with "party"]} {
+ if {$start_with eq "party"} {
set start_with_clause [db_map start_with_clause_party]
} else {
set start_with_clause [db_map start_with_clause]
@@ -243,7 +243,7 @@
} {
if {$party_id eq "" && $email eq ""} {
error "You need to provide either party_id or email"
- } elseif {![string eq "" $party_id] && ![string eq "" $email]} {
+ } elseif {"" ne $party_id && "" ne $email } {
error "Only provide provide party_id OR email, not both"
}
@@ -258,11 +258,11 @@
set name [db_string get_org_name {} -default ""]
}
- if { [empty_string_p $name] } {
+ if { $name eq "" } {
set name [db_string get_group_name {} -default ""]
}
- if { [empty_string_p $name] } {
+ if { $name eq "" } {
set name [db_string get_party_name {} -default ""]
}
Index: openacs-4/packages/acs-subsite/tcl/plpgsql-utility-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/plpgsql-utility-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/tcl/plpgsql-utility-procs.tcl 16 Jan 2003 13:38:14 -0000 1.3
+++ openacs-4/packages/acs-subsite/tcl/plpgsql-utility-procs.tcl 10 Jan 2007 21:22:06 -0000 1.4
@@ -63,7 +63,7 @@
if { [info exists user_supplied($arg_name)] } {
lappend pieces "${prepend}$user_supplied($arg_name)"
} else {
- if { $arg_default == "" } {
+ if { $arg_default eq "" } {
lappend pieces "NULL"
} else {
lappend pieces "'[db_quote $arg_default]'"
@@ -150,11 +150,11 @@
foreach triple $attr_list {
set attr [string trim [lindex $triple 1]]
set dft [string trim [lindex $triple 2]]
- if { [empty_string_p $dft] || $dft == "NULL" } {
+ if { $dft eq "" || $dft eq "NULL" } {
set default ""
} else {
- if { [string index $dft 0] == "'" } {
- set dft [string range $dft 1 [expr [string length $dft] - 2]]
+ if { [string index $dft 0] eq "'" } {
+ set dft [string range $dft 1 [expr {[string length $dft] - 2}]]
}
set default ";${dft}"
}
Index: openacs-4/packages/acs-subsite/tcl/plsql-utility-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/plsql-utility-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/tcl/plsql-utility-procs.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/tcl/plsql-utility-procs.tcl 10 Jan 2007 21:22:06 -0000 1.2
@@ -30,7 +30,7 @@
@creation-date 11/2000
} {
- set max_length_without_stem [expr $max_length - [expr [string length $stem] + 1]]
+ set max_length_without_stem [expr $max_length - [expr {[string length $stem] + 1}]]
set text "${table}_$column"
if { [string length $text] > $max_length_without_stem } {
@@ -41,7 +41,7 @@
}
append text "_$column"
}
- return [string toupper "[string range $text 0 [expr $max_length_without_stem - 1]]_$stem"]
+ return [string toupper "[string range $text 0 [expr {$max_length_without_stem - 1}]]_$stem"]
}
ad_proc -public object_type_exists_p { object_type } {
@@ -109,14 +109,14 @@
# Generate text
set text ""
- set col_width [expr $max_length + $num_spaces]
+ set col_width [expr {$max_length + $num_spaces}]
foreach pair $pieces {
set left [lindex $pair 0]
set right [lindex $pair 1]
while { [string length $left] < $col_width } {
append left " "
}
- if { ![empty_string_p $text] } {
+ if { $text ne "" } {
append text "$line_term\n$indent_text"
}
append text "${left}${delim}${right}"
@@ -147,7 +147,7 @@
} {
- if { $include_object_id == "t" } {
+ if { $include_object_id eq "t" } {
set id [db_nextval "acs_object_id_seq"]
set suffix "_$id"
} else {
@@ -161,11 +161,11 @@
# change spaces to underscores
regsub -all {\s+} $stem "_" stem
#Trim to fit in $max_length character limit
- set max_length_without_suffix [expr $max_length - [string length $suffix]]
+ set max_length_without_suffix [expr {$max_length - [string length $suffix]}]
if { [string length $stem] >= $max_length_without_suffix } {
- set stem [string range $stem 0 [expr $max_length_without_suffix - 1]]
+ set stem [string range $stem 0 [expr {$max_length_without_suffix - 1}]]
}
- if { [empty_string_p $stem] } {
+ if { $stem eq "" } {
error "generate_oracle_name failed to generate a safe oracle name from the stem \"$stem\"\n"
}
return "$stem$suffix"
@@ -269,7 +269,7 @@
foreach row $pairs {
set attr [string trim [lindex $row 0]]
set attr_value [string trim [lindex $row 1]]
- if { [empty_string_p $attr_value] } {
+ if { $attr_value eq "" } {
set attr_value $attr
}
lappend pieces [list "$attr" "$prepend$attr_value"]
@@ -302,7 +302,7 @@
# Ignore this column
continue
}
- if { [string equal $table $table_name] } {
+ if {$table eq $table_name} {
lappend this_columns "$prepend$column"
}
}
@@ -311,7 +311,7 @@
return ""
}
set return_value [join $this_columns ", "]
- if { $start_with_comma == "t" } {
+ if { $start_with_comma eq "t" } {
return ", $return_value"
}
return $return_value
Index: openacs-4/packages/acs-subsite/tcl/rel-segments-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/rel-segments-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/tcl/rel-segments-procs.tcl 30 Sep 2003 12:10:03 -0000 1.3
+++ openacs-4/packages/acs-subsite/tcl/rel-segments-procs.tcl 10 Jan 2007 21:22:06 -0000 1.4
@@ -27,10 +27,10 @@
} {
if { [ad_conn isconnected] } {
- if { [empty_string_p $creation_user] } {
+ if { $creation_user eq "" } {
set creation_user [ad_conn user_id]
}
- if { [empty_string_p $creation_ip] } {
+ if { $creation_ip eq "" } {
set creation_ip [ad_conn peeraddr]
}
}
Index: openacs-4/packages/acs-subsite/tcl/rel-types-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/rel-types-procs.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-subsite/tcl/rel-types-procs.tcl 18 Nov 2005 10:40:01 -0000 1.8
+++ openacs-4/packages/acs-subsite/tcl/rel-types-procs.tcl 10 Jan 2007 21:22:06 -0000 1.9
@@ -43,9 +43,9 @@
@author Michael Bryzek (mbryzek@arsdigita.com)
@creation-date 12/2000
} {
- if {![empty_string_p $group_id]} {
+ if {$group_id ne ""} {
return [additional_rel_types_group_p $group_id]
- } elseif {![empty_string_p $group_type]} {
+ } elseif {$group_type ne ""} {
return [additional_rel_types_group_type_p $group_type]
} else {
error "rel_types::rel_types_p error: One of group_id or group_type must be specified"
@@ -136,7 +136,7 @@
# use 29 chars to leave 1 character in the name for later dynamic
# views
- if {[empty_string_p $table_name]} {
+ if {$table_name eq ""} {
set table_name [plsql_utility::generate_oracle_name \
-max_length 29 "${rel_type}_ext"]
}
@@ -183,7 +183,7 @@
# The following create table statement commits the transaction. If it
# fails, we roll back what we've done
- if {$create_table_p == "t"} {
+ if {$create_table_p eq "t"} {
if {[catch {db_exec_plsql create_table "
create table $table_name (
rel_id constraint $fk_constraint_name
@@ -193,7 +193,7 @@
# Roll back our work so for
- for {set i [expr [llength $plsql_drop] - 1]} {$i >= 0} {incr i -1} {
+ for {set i [expr {[llength $plsql_drop] - 1}]} {$i >= 0} {incr i -1} {
set drop_pair [lindex $plsql_drop $i]
if {[catch {eval [lindex $drop_pair 0] [lindex $drop_pair 1] [lindex $drop_pair 2]} err_msg_2]} {
append errmsg "\nAdditional error while trying to roll back: $err_msg_2"
Index: openacs-4/packages/acs-subsite/tcl/relation-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/relation-procs.tcl,v
diff -u -r1.14 -r1.15
--- openacs-4/packages/acs-subsite/tcl/relation-procs.tcl 10 Jun 2005 14:32:56 -0000 1.14
+++ openacs-4/packages/acs-subsite/tcl/relation-procs.tcl 10 Jan 2007 21:22:06 -0000 1.15
@@ -73,7 +73,7 @@
and object_id_two = :object_id_two
} -default {}]
- if { ![empty_string_p $existing_rel_id] } {
+ if { $existing_rel_id ne "" } {
return $existing_rel_id
}
@@ -85,7 +85,7 @@
# membership relation before adding the member_state variable. The
# package_instantiate_object proc will ignore the member_state variable
# if the rel_type's plsql package doesn't support it.
- if {![empty_string_p $member_state]} {
+ if {$member_state ne ""} {
lappend var_list [list member_state $member_state]
}
@@ -117,7 +117,7 @@
# select rel_constraint.violation(:rel_id) from dual
# } -default ""]
#
- # if { ![empty_string_p $violated_err_msg] } {
+ # if { $violated_err_msg ne "" } {
# error $violated_err_msg
# }
} on_error {
@@ -158,7 +158,7 @@
# relation. Note that this segment is defined by joining against
# acs_rels to find the group and rel_type for this relation.
- if { ![empty_string_p $segment_id] } {
+ if { $segment_id ne "" } {
if { [relation_segment_has_dependant -segment_id $segment_id -party_id $party_id] } {
error "Relational constraints violated by removing this relation"
}
@@ -187,14 +187,14 @@
} {
- if { ![empty_string_p $rel_id] } {
+ if { $rel_id ne "" } {
if { ![db_0or1row select_rel_info {}] } {
# There is either no relation or no segment... thus no dependants
return 0
}
}
- if { [empty_string_p $segment_id] || [empty_string_p $party_id] } {
+ if { $segment_id eq "" || $party_id eq "" } {
error "Both of segment_id and party_id must be specified in call to relation_segment_has_dependant"
}
@@ -219,7 +219,7 @@
[application_group::group_id_from_package_id]
@param rel_type
} {
- if {[empty_string_p $group_id]} {
+ if {$group_id eq ""} {
set group_id [application_group::group_id_from_package_id]
}
@@ -265,7 +265,7 @@
[applcation_group::group_id_from_package_id] is used.
} {
- if {[empty_string_p $group_id]} {
+ if {$group_id eq ""} {
set group_id [application_group::group_id_from_package_id]
}
@@ -288,7 +288,7 @@
Sets up a multirow datasource.
Also returns a list containing the most essential information.
} {
- if {[empty_string_p $group_id]} {
+ if {$group_id eq ""} {
set group_id [application_group::group_id_from_package_id]
}
@@ -358,8 +358,8 @@
} {
Return the list of object_ids if a relation of rel_type exists between the supplied object_id and it.
} {
- if {[empty_string_p $object_id_one]} {
- if {[empty_string_p $object_id_two]} {
+ if {$object_id_one eq ""} {
+ if {$object_id_two eq ""} {
ad_return_error "[_ acs-subsite.Missing_argument]" "[_ acs-subsite.lt_You_have_to_provide_a]"
} else {
return [relation::get_object_one -object_id_two $object_id_two -rel_type $rel_type -multiple]
Index: openacs-4/packages/acs-subsite/tcl/subsite-callback-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/subsite-callback-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-subsite/tcl/subsite-callback-procs.tcl 29 Jul 2006 00:28:31 -0000 1.4
+++ openacs-4/packages/acs-subsite/tcl/subsite-callback-procs.tcl 10 Jan 2007 21:22:06 -0000 1.5
@@ -34,7 +34,7 @@
not specified
} {
- if { [empty_string_p $object_type] } {
+ if { $object_type eq "" } {
db_1row select_object_type {
select object_type
from acs_objects
Index: openacs-4/packages/acs-subsite/tcl/subsite-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/tcl/subsite-procs.tcl,v
diff -u -r1.35 -r1.36
--- openacs-4/packages/acs-subsite/tcl/subsite-procs.tcl 27 Jul 2006 01:08:14 -0000 1.35
+++ openacs-4/packages/acs-subsite/tcl/subsite-procs.tcl 10 Jan 2007 21:22:06 -0000 1.36
@@ -130,7 +130,7 @@
array set node [site_node::get_from_object_id -object_id $package_id]
set node_id $node(node_id)
- if { [empty_string_p $name] } {
+ if { $name eq "" } {
set subsite_name [db_string subsite_name_query {}]
} else {
set subsite_name $name
@@ -243,12 +243,12 @@
@return The package id of the newly mounted package
} {
- if { [empty_string_p $node_id] } {
+ if { $node_id eq "" } {
set node_id [ad_conn node_id]
}
set ctr 2
- if { [empty_string_p $instance_name] } {
+ if { $instance_name eq "" } {
# Default the instance name to the package key. Add a number,
# if necessary, until we find a unique name
set instance_name $package_key
@@ -260,7 +260,7 @@
regsub -all { } $instance_name "-" instance_name
}
- if { [empty_string_p $pretty_name] } {
+ if { $pretty_name eq "" } {
# Get the name of the object mounted at this node
db_1row select_package_object_names {
select t.pretty_name as package_name, acs_object.name(s.object_id) as object_name
@@ -271,7 +271,7 @@
set pretty_name "$object_name $package_name"
if { $ctr > 2 } {
# This was a duplicate pkg name... append the ctr used in the instance name
- append pretty_name " [expr $ctr - 1]"
+ append pretty_name " [expr {$ctr - 1}]"
}
}
@@ -293,7 +293,7 @@
@return the packages keys of all installed packages acting as subsites.
} {
if {$no_cache_p} {
- #if {[catch {set keys [db_list get_keys {}]} errMsg] || [empty_string_p $keys]} {
+ #if {[catch {set keys [db_list get_keys {}]} errMsg] || $keys eq ""} {
return {acs-subsite}
# }
return $keys
@@ -318,7 +318,7 @@
} {
upvar $array subsite_info
- if { [empty_string_p $subsite_id] } {
+ if { $subsite_id eq "" } {
set subsite_id [ad_conn subsite_id]
}
@@ -352,7 +352,7 @@
@author Frank Nikolajsen (frank@warpspace.com)
@creation-date 2003-03-08
} {
- if { [empty_string_p $subsite_id] } {
+ if { $subsite_id eq "" } {
set subsite_id [ad_conn subsite_id]
}
@@ -429,7 +429,7 @@
foreach type $type_list {
lappend path_list $type
- if {[string equal $type $ancestor_type]} {
+ if {$type eq $ancestor_type} {
break
}
}
@@ -558,7 +558,7 @@
upvar $array info
# the folder index page is called .
- if { [string equal $info(url) ""] || [string equal $info(url) "index"] || \
+ if { $info(url) eq "" || $info(url) eq "index" || \
[string match "*/" $info(url)] || [string match "*/index" $info(url)] } {
set info(url) "[string range $info(url) 0 [string last / $info(url)]]."
}
@@ -572,7 +572,7 @@
# Need to prepend the path from the subsite to this package
set current_url [string range [ad_conn url] [string length $base_url] end]
}
- if { [empty_string_p $current_url] || [string equal $current_url "index"] || \
+ if { $current_url eq "" || $current_url eq "index" || \
[string match "*/" $current_url] || [string match "*/index" $current_url] } {
set current_url "[string range $current_url 0 [string last / $current_url]]."
}
@@ -583,7 +583,7 @@
# Default to not selected
set selected_p 0
- if { [string equal $current_url $info(url)] || [string equal $info(name) $section] } {
+ if { $current_url eq $info(url) || $info(name) eq $section } {
set selected_p 1
} else {
foreach pattern $info(selected_patterns) {
@@ -595,7 +595,7 @@
}
}
- set link_p [expr ![string equal $current_url $info(url)]]
+ set link_p [expr {$current_url ne $info(url) }]
template::multirow append $multirow \
$info(name) \
@@ -654,7 +654,7 @@
set child_urls [lsort -ascii [site_node::get_children -node_id $subsite_node_id -package_type apm_application]]
- if { [empty_string_p $index_redirect_url] } {
+ if { $index_redirect_url eq "" } {
lappend pageflow home {
label "Home"
folder ""
@@ -668,7 +668,7 @@
# See if the redirect-url to a package inside this subsite
for { set i 0 } { $i < [llength $child_urls] } { incr i } {
array set child_node [site_node::get_from_url -exact -url [lindex $child_urls $i]]
- if { [string equal $index_redirect_url $child_node(url)] ||
+ if { $index_redirect_url eq $child_node(url) ||
[string equal ${index_redirect_url}/ $child_node(url)]} {
lappend pageflow $child_node(name) [list \
label "Home" \
@@ -788,7 +788,7 @@
set current_master [parameter::get -parameter DefaultMaster -package_id [ad_conn subsite_id]]
set found_p 0
foreach elm $master_template_options {
- if { [string equal $current_master [lindex $elm 1]] } {
+ if {$current_master eq [lindex $elm 1]} {
set found_p 1
break
}
@@ -852,7 +852,7 @@
regardless of the current connection state
} {
if {[ad_conn isconnected]} {
- if {[string equal $node_id ""]} {
+ if {$node_id eq ""} {
set node_id [ad_conn subsite_node_id]
}
@@ -868,13 +868,13 @@
set host_addr [split [ns_set iget $headers host] :]
set request(vhost) [lindex $host_addr 0]
- if {![string equal [lindex $host_addr 1] ""]} {
+ if {[lindex $host_addr 1] ne "" } {
set request(port) [lindex $host_addr 1]
}
- set request_vhost_p [expr {![string equal $main_host $request(vhost)]}]
+ set request_vhost_p [expr {$main_host ne $request(vhost) }]
} else {
- if {[string equal $node_id ""]} {
+ if {$node_id eq ""} {
error "You must supply node_id when not connected."
} else {
array set subsite_node [site_node::get -node_id $node_id]
@@ -886,14 +886,14 @@
set default_port(http) 80
set default_port(https) 443
- set force_host_p [expr {![string equal $force_host ""]}]
+ set force_host_p [expr {$force_host ne "" }]
- set force_protocol_p [expr {![string equal $protocol ""]}]
+ set force_protocol_p [expr {$protocol ne "" }]
if {!$force_protocol_p} {
set protocol http
}
- set force_port_p [expr {![string equal $port ""]}]
+ set force_port_p [expr {$port ne "" }]
if {!$force_port_p} {
set port 80
}
@@ -911,7 +911,7 @@
# Figure out which hostname to use
if {!$force_host_p} {
set search_vhost $request(vhost)
- } elseif {[string equal $force_host "any"]} {
+ } elseif {$force_host eq "any"} {
if {$request_vhost_p} {
set search_vhost $request(vhost)
set where_clause [db_map orderby]
@@ -924,19 +924,19 @@
set site_node $subsite_node(node_id)
set mapped_vhost [db_string get_vhost {} -default ""]
- if {$root_p && [string equal $mapped_vhost ""]} {
+ if {$root_p && $mapped_vhost eq ""} {
if {$strict_p} {
error "$search_vhost is not mapped to this subsite or any of its parents."
}
- if {[string equal $search_vhost "any"]} {
+ if {$search_vhost eq "any"} {
set mapped_vhost $main_host
} else {
set mapped_vhost $search_vhost
}
}
- if {[string equal $mapped_vhost ""]} {
+ if {$mapped_vhost eq ""} {
set result "[subsite::get_url \
-node_id $subsite_node(parent_id) \
-absolute_p $absolute_p \
@@ -957,7 +957,7 @@
if {$absolute_p} {
set result "${protocol}://${mapped_vhost}"
- if {![string equal $port $default_port($protocol)]} {
+ if {$port ne $default_port($protocol) } {
append result ":$port"
}
@@ -970,7 +970,7 @@
if {$absolute_p} {
set result "${protocol}://${main_host}"
- if {![string equal $port $default_port($protocol)]} {
+ if {$port ne $default_port($protocol) } {
append result ":$port"
}
@@ -995,7 +995,7 @@
# need to strip nodes which have no mounted package...
set packages [list]
foreach package [site_node::get_children -all -node_id $node_id -element package_id] {
- if {![empty_string_p $package]} {
+ if {$package ne ""} {
lappend packages $package
}
}
Index: openacs-4/packages/acs-subsite/www/group-master.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/group-master.tcl,v
diff -u -r1.11 -r1.12
--- openacs-4/packages/acs-subsite/www/group-master.tcl 27 Feb 2004 15:51:25 -0000 1.11
+++ openacs-4/packages/acs-subsite/www/group-master.tcl 10 Jan 2007 21:22:06 -0000 1.12
@@ -30,6 +30,6 @@
# Where to find the stylesheet
set css_url "/resources/acs-subsite/group-master.css"
-if { [string equal [ad_conn url] $subsite_url] } {
+if {[ad_conn url] eq $subsite_url} {
set subsite_url {}
}
Index: openacs-4/packages/acs-subsite/www/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/index.tcl,v
diff -u -r1.20 -r1.21
--- openacs-4/packages/acs-subsite/www/index.tcl 31 Mar 2004 21:45:40 -0000 1.20
+++ openacs-4/packages/acs-subsite/www/index.tcl 10 Jan 2007 21:22:06 -0000 1.21
@@ -22,20 +22,20 @@
# We may have to redirect to some application page
set redirect_url [parameter::get -parameter IndexRedirectUrl -default {}]
-if { [empty_string_p $redirect_url] && $main_site_p } {
+if { $redirect_url eq "" && $main_site_p } {
set redirect_url [parameter::get_from_package_key -package_key acs-kernel -parameter IndexRedirectUrl]
}
-if { ![empty_string_p $redirect_url] } {
+if { $redirect_url ne "" } {
ad_returnredirect $redirect_url
ad_script_abort
}
# Handle IndexInternalRedirectUrl
set redirect_url [parameter::get -parameter IndexInternalRedirectUrl -default {}]
-if { [empty_string_p $redirect_url] && $main_site_p } {
+if { $redirect_url eq "" && $main_site_p } {
set redirect_url [parameter::get_from_package_key -package_key acs-kernel -parameter IndexInternalRedirectUrl]
}
-if { ![empty_string_p $redirect_url] } {
+if { $redirect_url ne "" } {
rp_internal_redirect $redirect_url
ad_script_abort
}
@@ -53,8 +53,8 @@
set show_members_list_to [parameter::get -parameter "ShowMembersListTo" -default 2]
set show_members_page_link_p \
- [expr $admin_p || ($user_id != 0 && $show_members_list_to ==1) || \
- $show_members_list_to == 0 ]
+ [expr {$admin_p || ($user_id != 0 && $show_members_list_to ==1) || \
+ $show_members_list_to == 0 }]
# User's group membership
@@ -64,4 +64,4 @@
set group_member_p [group::member_p -group_id $group_id -user_id $user_id]
set group_admin_p [group::admin_p -group_id $group_id -user_id $user_id]
-set can_join_p [expr !$group_admin_p && $group_member_p == 0 && $user_id != 0 && ![string equal $group_join_policy "closed"]]
+set can_join_p [expr {!$group_admin_p && $group_member_p == 0 && $user_id != 0 && $group_join_policy ne "closed" }]
Index: openacs-4/packages/acs-subsite/www/admin/subsite-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/subsite-add.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-subsite/www/admin/subsite-add.tcl 8 Feb 2004 17:36:16 -0000 1.9
+++ openacs-4/packages/acs-subsite/www/admin/subsite-add.tcl 10 Jan 2007 21:22:06 -0000 1.10
@@ -47,7 +47,7 @@
-folder $folder \
-instance_name $instance_name]
- if { [empty_string_p $folder] } {
+ if { $folder eq "" } {
form set_error subsite folder "This folder name is already used"
break
}
@@ -77,7 +77,7 @@
-user_id [ad_conn user_id]
# Set inheritance (called 'visibility' in form)
- if { ![string equal $visibility "any"] } {
+ if { $visibility ne "any" } {
permission::set_not_inherit -object_id $new_package_id
}
Index: openacs-4/packages/acs-subsite/www/admin/applications/application-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/applications/application-add.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-subsite/www/admin/applications/application-add.tcl 20 Apr 2004 21:12:59 -0000 1.9
+++ openacs-4/packages/acs-subsite/www/admin/applications/application-add.tcl 10 Jan 2007 21:22:06 -0000 1.10
@@ -49,16 +49,16 @@
set instance_name $node(instance_name)
set folder $node(name)
} -on_submit {
- if { [empty_string_p $instance_name] } {
+ if { $instance_name eq "" } {
# Find the package pretty name from the list of packages
foreach elm $packages {
- if { [string equal [lindex $elm 1] $package_key] } {
+ if {[lindex $elm 1] eq $package_key} {
set instance_name [lindex $elm 0]
break
}
}
- if { [empty_string_p $instance_name] } {
+ if { $instance_name eq "" } {
error "Couldn't find package_key '$package_key' in list of system applications"
}
@@ -76,7 +76,7 @@
-folder $folder \
-instance_name $instance_name]
- if { [empty_string_p $folder] } {
+ if { $folder eq "" } {
form set_error application folder "This folder name is already used"
break
}
Index: openacs-4/packages/acs-subsite/www/admin/attributes/add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/attributes/add-2.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-subsite/www/admin/attributes/add-2.tcl 6 Sep 2002 21:49:57 -0000 1.2
+++ openacs-4/packages/acs-subsite/www/admin/attributes/add-2.tcl 10 Jan 2007 21:22:06 -0000 1.3
@@ -39,7 +39,7 @@
# Right now, we do not support multiple values for attributes
set max_n_values 1
-if { [string eq $required_p "t"] } {
+if {$required_p eq "t"} {
set min_n_values 1
} else {
set min_n_values 0
@@ -56,9 +56,9 @@
}
# If we're an enumeration, redirect to start adding possible values.
-if { [string equal $datatype "enumeration"] } {
+if {$datatype eq "enumeration"} {
ad_returnredirect enum-add?[ad_export_vars {attribute_id return_url}]
-} elseif { [empty_string_p $return_url] } {
+} elseif { $return_url eq "" } {
ad_returnredirect add?[ad_export_vars {object_type}]
} else {
ad_returnredirect $return_url
Index: openacs-4/packages/acs-subsite/www/admin/attributes/delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/attributes/delete-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/attributes/delete-2.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/attributes/delete-2.tcl 10 Jan 2007 21:22:06 -0000 1.2
@@ -14,7 +14,7 @@
{ operation "" }
}
-if { [string eq $operation "Yes, I really want to delete this attribute"] } {
+if {$operation eq "Yes, I really want to delete this attribute"} {
db_transaction {
set object_type [db_string select_object_type {
select attr.object_type
@@ -23,12 +23,12 @@
} -default ""]
# If object type is empty, that means the attribute doesn't exist
- if { ![empty_string_p $object_type] && [attribute::delete $attribute_id] } {
+ if { $object_type ne "" && [attribute::delete $attribute_id] } {
# Recreate all the packages to use the new attribute
package_recreate_hierarchy $object_type
}
}
-} elseif { [empty_string_p $return_url] } {
+} elseif { $return_url eq "" } {
set return_url one?[ad_export_vars attribute_id]
}
Index: openacs-4/packages/acs-subsite/www/admin/attributes/edit-one.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/attributes/edit-one.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/admin/attributes/edit-one.tcl 18 Sep 2002 12:16:40 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/admin/attributes/edit-one.tcl 10 Jan 2007 21:22:06 -0000 1.4
@@ -55,7 +55,7 @@
-optional -datatype text -widget hidden
-if { [string eq $datatype "enumeration"] } {
+if {$datatype eq "enumeration"} {
set focus ""
set option_list [db_list_of_lists select_enum_values {
select enum.pretty_name, enum.enum_value
Index: openacs-4/packages/acs-subsite/www/admin/attributes/enum-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/attributes/enum-add-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/attributes/enum-add-2.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/attributes/enum-add-2.tcl 10 Jan 2007 21:22:06 -0000 1.2
@@ -23,10 +23,10 @@
db_transaction {
foreach ideal_sort_order [array names attribute_enum_values] {
- set sort_order [expr $ideal_sort_order + $max_sort_order]
+ set sort_order [expr {$ideal_sort_order + $max_sort_order}]
set pretty_name $attribute_enum_values($ideal_sort_order)
# delete if the value is empty. Update otherwise
- if { [empty_string_p $pretty_name] } {
+ if { $pretty_name eq "" } {
db_dml delete_enum_value {
delete from acs_enum_values
where attribute_id = :attribute_id
@@ -59,10 +59,10 @@
db_release_unused_handles
-if { [string equal $operation "Add more values"] } {
+if {$operation eq "Add more values"} {
# redirect to add more values
set return_url enum-add?[ad_export_vars {attribute_id return_url}]
-} elseif { [empty_string_p $return_url] } {
+} elseif { $return_url eq "" } {
set return_url one?[ad_export_vars attribute_id]
}
Index: openacs-4/packages/acs-subsite/www/admin/attributes/enum-add.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/attributes/enum-add.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-subsite/www/admin/attributes/enum-add.tcl 6 Sep 2002 21:49:57 -0000 1.2
+++ openacs-4/packages/acs-subsite/www/admin/attributes/enum-add.tcl 10 Jan 2007 21:22:06 -0000 1.3
@@ -40,7 +40,7 @@
template::multirow create value_form sort_order field_name
for { set i 1 } { $i <= $max_values } { incr i } {
- template::multirow append value_form [expr $i + $number_values] "attribute_enum_values.[expr $i + $number_values]"
+ template::multirow append value_form [expr {$i + $number_values}] "attribute_enum_values.[expr {$i + $number_values}]"
}
db_1row select_attr_name {
Index: openacs-4/packages/acs-subsite/www/admin/attributes/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/attributes/one.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-subsite/www/admin/attributes/one.tcl 6 Sep 2002 21:49:57 -0000 1.2
+++ openacs-4/packages/acs-subsite/www/admin/attributes/one.tcl 10 Jan 2007 21:22:06 -0000 1.3
@@ -43,7 +43,7 @@
template::multirow append attr_props $n $attribute($n)
}
-if { [string eq $attribute(datatype) "enumeration"] } {
+if {$attribute(datatype) eq "enumeration"} {
# set up the enum values datasource
db_multirow enum_values enum_values {
select v.enum_value, v.pretty_name
Index: openacs-4/packages/acs-subsite/www/admin/attributes/value-delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/attributes/value-delete-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/attributes/value-delete-2.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/attributes/value-delete-2.tcl 10 Jan 2007 21:22:06 -0000 1.2
@@ -15,7 +15,7 @@
{ return_url "one?[ad_export_vars attribute_id]" }
}
-if { [string eq $operation "Yes, I really want to delete this attribute value"] } {
+if {$operation eq "Yes, I really want to delete this attribute value"} {
db_transaction {
attribute::value_delete $attribute_id $enum_value
}
Index: openacs-4/packages/acs-subsite/www/admin/group-types/change-join-policy-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/group-types/change-join-policy-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/group-types/change-join-policy-2.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/group-types/change-join-policy-2.tcl 10 Jan 2007 21:22:06 -0000 1.2
@@ -24,7 +24,7 @@
return
}
-if {![string equal $dynamic_p t]} {
+if {$dynamic_p ne "t" } {
ad_return_error "Cannot administer group type" "Group type \"$group_type\" can only be administered by programmers"
}
@@ -44,7 +44,7 @@
}
}
-if {[empty_string_p $return_url]} {
+if {$return_url eq ""} {
set return_url one?[ad_export_vars group_type]
}
Index: openacs-4/packages/acs-subsite/www/admin/group-types/change-join-policy.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/group-types/change-join-policy.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/admin/group-types/change-join-policy.tcl 6 Sep 2002 21:49:58 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/admin/group-types/change-join-policy.tcl 10 Jan 2007 21:22:06 -0000 1.4
@@ -37,7 +37,7 @@
return
}
-if {![string equal $dynamic_p t]} {
+if {$dynamic_p ne "t" } {
ad_return_error "Cannot administer group type" "Group type \"$group_type\" can only be administered by programmers"
}
Index: openacs-4/packages/acs-subsite/www/admin/group-types/delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/group-types/delete-2.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-subsite/www/admin/group-types/delete-2.tcl 6 Sep 2002 21:49:58 -0000 1.4
+++ openacs-4/packages/acs-subsite/www/admin/group-types/delete-2.tcl 10 Jan 2007 21:22:06 -0000 1.5
@@ -22,8 +22,8 @@
}
}
-if { ![string eq $operation "Yes, I really want to delete this group type"] } {
- if { [empty_string_p $return_url] } {
+if { $operation ne "Yes, I really want to delete this group type" } {
+ if { $return_url eq "" } {
ad_returnredirect "one?[ad_export_vars {group_type}]"
} else {
ad_returnredirect $return_url
@@ -72,7 +72,7 @@
}
# Make sure we drop the table last
-if { ![empty_string_p $table_name] && [db_table_exists $table_name] } {
+if { $table_name ne "" && [db_table_exists $table_name] } {
lappend plsql [list "drop_table" [db_map drop_table]]
}
@@ -89,7 +89,7 @@
db_transaction {
# First delete the groups
- if { ![empty_string_p $package_name] } {
+ if { $package_name ne "" } {
foreach group_id [db_list select_group_ids {
select o.object_id
Index: openacs-4/packages/acs-subsite/www/admin/group-types/rel-type-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/group-types/rel-type-add-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/group-types/rel-type-add-2.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/group-types/rel-type-add-2.tcl 10 Jan 2007 21:22:06 -0000 1.2
@@ -47,7 +47,7 @@
db_release_unused_handles
-if { [empty_string_p $return_url] } {
+if { $return_url eq "" } {
set return_url "one?[ad_export_vars {group_type}]"
}
Index: openacs-4/packages/acs-subsite/www/admin/group-types/rel-type-remove-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/group-types/rel-type-remove-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/group-types/rel-type-remove-2.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/group-types/rel-type-remove-2.tcl 10 Jan 2007 21:22:06 -0000 1.2
@@ -14,7 +14,7 @@
{ operation:trim "No, I want to cancel my request" }
}
-if { [empty_string_p $return_url] } {
+if { $return_url eq "" } {
# Pull out the group_type now as we may delete the row later
db_1row select_group_type {
select g.group_type
@@ -24,7 +24,7 @@
set return_url one?[ad_export_vars {group_type}]
}
-if { [string eq $operation "Yes, I really want to remove this relationship type"] } {
+if {$operation eq "Yes, I really want to remove this relationship type"} {
db_transaction {
db_dml remove_relation {
delete from group_type_rels where group_rel_type_id = :group_rel_type_id
Index: openacs-4/packages/acs-subsite/www/admin/groups/change-join-policy-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/groups/change-join-policy-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/groups/change-join-policy-2.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/groups/change-join-policy-2.tcl 10 Jan 2007 21:22:07 -0000 1.2
@@ -32,7 +32,7 @@
where group_id = :group_id
}
-if {[empty_string_p $return_url]} {
+if {$return_url eq ""} {
set return_url one?group_id=@group_id@
}
Index: openacs-4/packages/acs-subsite/www/admin/groups/constraints-create-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/groups/constraints-create-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/groups/constraints-create-2.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/groups/constraints-create-2.tcl 10 Jan 2007 21:22:07 -0000 1.2
@@ -18,15 +18,15 @@
set operation [string trim [string tolower $operation]]
-if { [string eq $operation "yes"] } {
- if { [empty_string_p $return_url] } {
+if {$operation eq "yes"} {
+ if { $return_url eq "" } {
# Setup return_url to send up back to the group admin page
# when we're all done
set return_url "[ad_conn package_url]/admin/groups/one?[ad_export_vars group_id]"
}
ad_returnredirect "../rel-segments/new?[ad_export_vars {group_id rel_type return_url}]"
} else {
- if { [empty_string_p $return_url] } {
+ if { $return_url eq "" } {
set return_url "one?[ad_export_vars group_id]"
}
ad_returnredirect $return_url
Index: openacs-4/packages/acs-subsite/www/admin/groups/delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/groups/delete-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/groups/delete-2.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/groups/delete-2.tcl 10 Jan 2007 21:22:07 -0000 1.2
@@ -20,15 +20,15 @@
}
}
-if { [string eq $operation "Yes, I really want to delete this group"] } {
+if {$operation eq "Yes, I really want to delete this group"} {
db_transaction {
set group_type [group::delete $group_id]
}
- if { [empty_string_p $return_url] && ![empty_string_p $group_type] } {
+ if { $return_url eq "" && $group_type ne "" } {
set return_url "../group-types/one?[ad_export_vars group_type]"
}
} else {
- if { [empty_string_p $return_url] } {
+ if { $return_url eq "" } {
set return_url "one?[ad_export_vars group_id]"
}
}
Index: openacs-4/packages/acs-subsite/www/admin/groups/elements-display-list.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/groups/elements-display-list.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/groups/elements-display-list.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/groups/elements-display-list.tcl 10 Jan 2007 21:22:07 -0000 1.2
@@ -46,8 +46,8 @@
set extra_tables ""
set extra_where_clauses ""
-if {[string equal $ancestor_rel_type membership_rel]} {
- if {![empty_string_p $member_state]} {
+if {$ancestor_rel_type eq "membership_rel"} {
+ if {$member_state ne ""} {
set extra_tables "membership_rels mr,"
set extra_where_clauses "
and mr.rel_id = rels.rel_id
Index: openacs-4/packages/acs-subsite/www/admin/groups/new.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/groups/new.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-subsite/www/admin/groups/new.tcl 27 Feb 2004 11:05:49 -0000 1.5
+++ openacs-4/packages/acs-subsite/www/admin/groups/new.tcl 10 Jan 2007 21:22:07 -0000 1.6
@@ -33,7 +33,7 @@
set context [list [list "[ad_conn package_url]admin/groups/" "Groups"] "Add a group"]
-if {[empty_string_p $add_to_group_id]} {
+if {$add_to_group_id eq ""} {
set add_to_group_id [application_group::group_id_from_package_id]
}
@@ -60,8 +60,8 @@
# Membership relations have a member_state attribute that gets set
# based on the group's join policy.
-if {[string equal $ancestor_rel_type membership_rel]} {
- if {[string equal $add_to_group_join_policy "closed"] && !$create_p} {
+if {$ancestor_rel_type eq "membership_rel"} {
+ if {$add_to_group_join_policy eq "closed" && !$create_p} {
ad_complain "You do not have permission to add elements to $add_to_group_name"
return
}
@@ -95,7 +95,7 @@
## constraint violations in the database because the constraints are enforced
## by triggers in the DB.
-if { [string eq $group_type_exact_p "f"] && \
+if { $group_type_exact_p eq "f" && \
[subsite::util::sub_type_exists_p $group_type] } {
# Sub rel-types exist... select one
Index: openacs-4/packages/acs-subsite/www/admin/groups/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/groups/one.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-subsite/www/admin/groups/one.tcl 11 Jun 2005 14:14:37 -0000 1.5
+++ openacs-4/packages/acs-subsite/www/admin/groups/one.tcl 10 Jan 2007 21:22:07 -0000 1.6
@@ -65,12 +65,12 @@
set mapped_trees [category_tree::get_mapped_trees $group_id]
foreach mapped_tree $mapped_trees {
util_unlist $mapped_tree tree_id tree_name subtree_id
- if {![empty_string_p $subtree_id]} {
+ if {$subtree_id ne ""} {
set tree_name "${tree_name}::[category::get_name $subtree_id]"
}
lappend category_trees $tree_name
}
- if {[empty_string_p $mapped_trees]} {
+ if {$mapped_trees eq ""} {
set category_trees "None"
}
set category_trees [join $category_trees ,]
Index: openacs-4/packages/acs-subsite/www/admin/groups/rel-type-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/groups/rel-type-add-2.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-subsite/www/admin/groups/rel-type-add-2.tcl 11 Aug 2001 21:31:03 -0000 1.2
+++ openacs-4/packages/acs-subsite/www/admin/groups/rel-type-add-2.tcl 10 Jan 2007 21:22:07 -0000 1.3
@@ -64,7 +64,7 @@
then 1 else 0 end
from dual
}] } {
- if { [empty_string_p $return_url] } {
+ if { $return_url eq "" } {
set return_url one?[ad_export_vars group_id]
}
ad_returnredirect $return_url
Index: openacs-4/packages/acs-subsite/www/admin/groups/rel-type-remove-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/groups/rel-type-remove-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/groups/rel-type-remove-2.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/groups/rel-type-remove-2.tcl 10 Jan 2007 21:22:07 -0000 1.2
@@ -26,7 +26,7 @@
ad_script_abort
}
-if { [string eq $operation "Yes, I really want to delete this relationship type"] } {
+if {$operation eq "Yes, I really want to delete this relationship type"} {
set rel_id_list [db_list select_rel_ids {
select r.rel_id
from acs_rels r
@@ -64,7 +64,7 @@
}
-if { [empty_string_p $return_url] } {
+if { $return_url eq "" } {
set return_url one?[ad_export_vars {group_id}]
}
Index: openacs-4/packages/acs-subsite/www/admin/parties/new.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/parties/new.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-subsite/www/admin/parties/new.tcl 29 Jun 2004 10:17:43 -0000 1.5
+++ openacs-4/packages/acs-subsite/www/admin/parties/new.tcl 10 Jan 2007 21:22:07 -0000 1.6
@@ -25,7 +25,7 @@
set context [list [list "" "Parties"] "Add a party"]
-if {[empty_string_p $add_to_group_id]} {
+if {$add_to_group_id eq ""} {
set add_to_group_id [application_group::group_id_from_package_id]
}
@@ -56,8 +56,8 @@
# Membership relations have a member_state attribute that gets set
# based on the group's join policy.
-if {[string equal $ancestor_rel_type membership_rel]} {
- if {[string equal $add_to_group_join_policy "closed"] && !$create_p} {
+if {$ancestor_rel_type eq "membership_rel"} {
+ if {$add_to_group_join_policy eq "closed" && !$create_p} {
ad_complain "You do not have permission to add elements to $add_to_group_name"
return
}
@@ -81,7 +81,7 @@
# Check if the new party needs to first be added in other segments before
# being added to $add_to_group_id using $add_with_rel_type.
-if {[empty_string_p $group_rel_type_list]} {
+if {$group_rel_type_list eq ""} {
set required_group_rel_type_list [relation_required_segments_multirow \
-datasource_name required_segments \
-group_id $add_to_group_id \
@@ -143,7 +143,7 @@
}
-if { [string eq $party_type_exact_p "f"] && \
+if { $party_type_exact_p eq "f" && \
[subsite::util::sub_type_exists_p $party_type] } {
# Sub party-types exist... select one
Index: openacs-4/packages/acs-subsite/www/admin/rel-segments/constraints-redirect.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/rel-segments/constraints-redirect.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/rel-segments/constraints-redirect.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/rel-segments/constraints-redirect.tcl 10 Jan 2007 21:22:07 -0000 1.2
@@ -16,10 +16,10 @@
set operation [string trim [string tolower $operation]]
-if { [string eq $operation "yes"] } {
+if {$operation eq "yes"} {
ad_returnredirect "constraints/new?rel_segment=$segment_id&[ad_export_vars return_url]"
} else {
- if { [empty_string_p $return_url] } {
+ if { $return_url eq "" } {
set return_url "one?[ad_export_vars segment_id]"
}
ad_returnredirect $return_url
Index: openacs-4/packages/acs-subsite/www/admin/rel-segments/delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/rel-segments/delete-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/rel-segments/delete-2.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/rel-segments/delete-2.tcl 10 Jan 2007 21:22:07 -0000 1.2
@@ -20,13 +20,13 @@
}
}
-if { [string eq $operation "Yes, I really want to delete this segment"] } {
- if { [empty_string_p $return_url] } {
+if {$operation eq "Yes, I really want to delete this segment"} {
+ if { $return_url eq "" } {
# Go back to the group for this segment
set group_id [db_string select_group_id {
select s.group_id from rel_segments s where s.segment_id = :segment_id
} -default ""]
- if { ![empty_string_p $group_id] } {
+ if { $group_id ne "" } {
set return_url "../groups/one?[ad_export_vars group_id]"
}
}
@@ -37,7 +37,7 @@
}
}
-if { [empty_string_p $return_url] } {
+if { $return_url eq "" } {
set return_url "one?[ad_export_vars {segment_id}]"
}
Index: openacs-4/packages/acs-subsite/www/admin/rel-segments/new-3.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/rel-segments/new-3.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/admin/rel-segments/new-3.tcl 6 Sep 2002 21:50:01 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/admin/rel-segments/new-3.tcl 10 Jan 2007 21:22:07 -0000 1.4
@@ -45,7 +45,7 @@
where s.group_id = :group_id
and s.rel_type = :rel_type
} -default ""]
- if { [empty_string_p $segment_id] } {
+ if { $segment_id eq "" } {
ad_return_error "Error creating segment" $errmsg
ad_script_abort
}
Index: openacs-4/packages/acs-subsite/www/admin/rel-segments/new.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/rel-segments/new.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-subsite/www/admin/rel-segments/new.tcl 6 Sep 2002 21:50:01 -0000 1.2
+++ openacs-4/packages/acs-subsite/www/admin/rel-segments/new.tcl 10 Jan 2007 21:22:07 -0000 1.3
@@ -30,7 +30,7 @@
set subsite_group_id [application_group::group_id_from_package_id]
# If the user has specified a rel_type, redirect to new-2
-if { ![empty_string_p $rel_type] } {
+if { $rel_type ne "" } {
ad_returnredirect new-2?[ad_export_vars {group_id rel_type return_url}]
ad_script_abort
}
Index: openacs-4/packages/acs-subsite/www/admin/rel-segments/constraints/delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/rel-segments/constraints/delete-2.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/admin/rel-segments/constraints/delete-2.tcl 30 Sep 2003 12:10:03 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/admin/rel-segments/constraints/delete-2.tcl 10 Jan 2007 21:22:07 -0000 1.4
@@ -18,9 +18,9 @@
set package_id [ad_conn package_id]
-if { [string eq $operation "Yes, I really want to delete this constraint"] } {
+if {$operation eq "Yes, I really want to delete this constraint"} {
- if { [empty_string_p $return_url] } {
+ if { $return_url eq "" } {
# Redirect to the rel-segment page by default.
if { [db_0or1row select_segment_id {
select c.rel_segment as segment_id from rel_constraints c where c.constraint_id = :constraint_id
@@ -49,7 +49,7 @@
}
db_release_unused_handles
-} elseif { [empty_string_p $return_url] } {
+} elseif { $return_url eq "" } {
# if we're not deleting, redirect to the constraint page
set return_url one?[ad_export_vars constraint_id]
}
Index: openacs-4/packages/acs-subsite/www/admin/rel-segments/constraints/new.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/rel-segments/constraints/new.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/admin/rel-segments/constraints/new.tcl 18 Sep 2002 12:16:42 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/admin/rel-segments/constraints/new.tcl 10 Jan 2007 21:22:07 -0000 1.4
@@ -147,7 +147,7 @@
ad_return_template violations
return
}
- if { [empty_string_p $return_url] } {
+ if { $return_url eq "" } {
set return_url "../one?segment_id=$rel_segment"
}
ad_returnredirect $return_url
Index: openacs-4/packages/acs-subsite/www/admin/rel-types/delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/rel-types/delete-2.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-subsite/www/admin/rel-types/delete-2.tcl 20 Aug 2001 05:15:29 -0000 1.2
+++ openacs-4/packages/acs-subsite/www/admin/rel-types/delete-2.tcl 10 Jan 2007 21:22:07 -0000 1.3
@@ -14,9 +14,9 @@
{ return_url "" }
}
-if { ![string eq $operation "Yes, I really want to delete this relationship type"] } {
+if { $operation ne "Yes, I really want to delete this relationship type" } {
# set the return_url to something useful if we are not deleting
- if { [empty_string_p $return_url] } {
+ if { $return_url eq "" } {
set return_url "one?[ad_export_vars rel_type]"
}
} else {
@@ -56,7 +56,7 @@
relation_remove $rel_id
}
- if { ![empty_string_p $segment_id] } {
+ if { $segment_id ne "" } {
rel_segments_delete $segment_id
}
Index: openacs-4/packages/acs-subsite/www/admin/rel-types/mapping-remove-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/rel-types/mapping-remove-2.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/admin/rel-types/mapping-remove-2.tcl 6 Sep 2002 21:50:03 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/admin/rel-types/mapping-remove-2.tcl 10 Jan 2007 21:22:07 -0000 1.4
@@ -17,16 +17,16 @@
context:onevalue
}
-if { [empty_string_p $group_rel_id] || [empty_string_p $group_type_rel_id] } {
+if { $group_rel_id eq "" || $group_type_rel_id eq "" } {
error "Either group_rel_id or group_rel_type_id must be specified"
}
-if { ![empty_string_p $group_rel_id] } {
+if { $group_rel_id ne "" } {
db_dml delete_group_rel_mapping {
delete from group_rels
where group_rel_id = :group_rel_id
}
-} elseif { ![empty_string_p $group_rel_id] } {
+} elseif { $group_rel_id ne "" } {
db_dml delete_group_type_rel_mapping {
delete from group_type_rels
where group_type_rel_id = :group_type_rel_id
Index: openacs-4/packages/acs-subsite/www/admin/rel-types/roles/delete-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/rel-types/roles/delete-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/rel-types/roles/delete-2.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/rel-types/roles/delete-2.tcl 10 Jan 2007 21:22:07 -0000 1.2
@@ -15,7 +15,7 @@
}
-if { [string eq $operation "Yes, I really want to delete this role"] } {
+if {$operation eq "Yes, I really want to delete this role"} {
db_transaction {
if { [catch {db_exec_plsql drop_role {begin acs_rel_type.drop_role(:role);end;}} errmsg] } {
if { [db_string role_used_p {
Index: openacs-4/packages/acs-subsite/www/admin/rel-types/roles/edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/rel-types/roles/edit.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/admin/rel-types/roles/edit.tcl 18 Sep 2002 12:16:43 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/admin/rel-types/roles/edit.tcl 10 Jan 2007 21:22:07 -0000 1.4
@@ -56,7 +56,7 @@
r.pretty_plural = :pretty_plural
where r.role = :role
} -bind [ns_getform]
- if { [empty_string_p $return_url] } {
+ if { $return_url eq "" } {
set return_url "one?[ad_export_vars role]"
}
ad_returnredirect $return_url
Index: openacs-4/packages/acs-subsite/www/admin/relations/add.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/relations/add.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-subsite/www/admin/relations/add.tcl 20 Apr 2004 21:12:59 -0000 1.9
+++ openacs-4/packages/acs-subsite/www/admin/relations/add.tcl 10 Jan 2007 21:22:08 -0000 1.10
@@ -25,13 +25,13 @@
add_party_url:onevalue
} -validate {
party_in_scope_p -requires {party_id:notnull} {
- if { [string equal $allow_out_of_scope_p "f"] && \
+ if { $allow_out_of_scope_p eq "f" && \
![application_group::contains_party_p -party_id $party_id]} {
ad_complain "The party either does not exist or does not belong to this subsite."
}
}
rel_type_valid_p -requires {group_id:notnull rel_type:notnull exact_p:notnull} {
- if {[string equal $exact_p t] && \
+ if {$exact_p eq "t" && \
![relation_type_is_valid_to_group_p -group_id $group_id $rel_type]} {
ad_complain "Relations of this type to this group would violate a relational constraint."
}
@@ -46,7 +46,7 @@
set export_var_list [list group_id rel_type exact_p return_url allow_out_of_scope_p]
-if {![empty_string_p $party_id]} {
+if {$party_id ne ""} {
lappend export_var_list party_id
}
@@ -81,8 +81,8 @@
# to be localized before they are displayed
set role_pretty_name [lang::util::localize $role_pretty_name]
-if {[string equal $ancestor_rel_type membership_rel]} {
- if {[string equal $join_policy "closed"] && !$create_p} {
+if {$ancestor_rel_type eq "membership_rel"} {
+ if {$join_policy eq "closed" && !$create_p} {
ad_complain "You do not have permission to add elements to $group_name"
return
}
@@ -92,7 +92,7 @@
set member_state ""
}
-if { [string eq $exact_p "f"] && \
+if { $exact_p eq "f" && \
[subsite::util::sub_type_exists_p $rel_type] } {
# Sub rel-types exist... select one
@@ -158,15 +158,15 @@
ad_return_error "Error creating the relation" "We got the following error message while trying to create this relation: <pre>$errmsg</pre>"
ad_script_abort
}
- if { [empty_string_p $return_url] } {
+ if { $return_url eq "" } {
set return_url one?[ad_export_vars rel_id]
}
ad_returnredirect $return_url
ad_script_abort
}
-if {![empty_string_p $party_id]} {
+if {$party_id ne ""} {
# ISSUES / TO DO: add a check to make sure the party is not
# already in the group. We only want to do this on is_request,
# in which case we know its not a double-click issue.
@@ -182,7 +182,7 @@
-widget "inform" -value "$party_name" -label "$role_pretty_name"
} else {
- if {[string equal $object_type_two party]} {
+ if {$object_type_two eq "party"} {
# We special case 'party' because we don't want to include
# parties whose direct object_type is:
# 'rel_segment' - users will get confused by segments here.
@@ -202,7 +202,7 @@
# the list of parties that can be added to $group_id with a relation
# of type $rel_type.
- if {[string equal $allow_out_of_scope_p "f"]} {
+ if {$allow_out_of_scope_p eq "f"} {
set scope_query [db_map select_parties_scope_query]
set scope_clause "
Index: openacs-4/packages/acs-subsite/www/admin/relations/change-member-state.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/relations/change-member-state.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/relations/change-member-state.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/relations/change-member-state.tcl 10 Jan 2007 21:22:08 -0000 1.2
@@ -32,7 +32,7 @@
}
-if {[empty_string_p $return_url]} {
+if {$return_url eq ""} {
set return_url "one?rel_id=$rel_id"
}
ad_returnredirect $return_url
\ No newline at end of file
Index: openacs-4/packages/acs-subsite/www/admin/relations/remove-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/relations/remove-2.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/admin/relations/remove-2.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/admin/relations/remove-2.tcl 10 Jan 2007 21:22:08 -0000 1.2
@@ -18,15 +18,15 @@
}
}
-if { [string eq $operation "Yes, I really want to remove this relation"] } {
+if {$operation eq "Yes, I really want to remove this relation"} {
db_transaction {
relation_remove $rel_id
} on_error {
ad_return_error "Error creating the relation" "We got the following error while trying to remove the relation: <pre>$errmsg</pre>"
ad_script_abort
}
} else {
- if { [empty_string_p $return_url] } {
+ if { $return_url eq "" } {
# redirect to the relation by default, if we haven't deleted it
set return_url "one?[ad_export_vars rel_id]"
}
Index: openacs-4/packages/acs-subsite/www/admin/site-map/allow-for-view.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/site-map/allow-for-view.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/admin/site-map/allow-for-view.tcl 1 Mar 2005 00:01:23 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/admin/site-map/allow-for-view.tcl 10 Jan 2007 21:22:08 -0000 1.4
@@ -23,12 +23,12 @@
# in the tree are also checked as well
foreach check_node $checkbox {
- if { [string equal $main_node $check_node] } {
+ if {$main_node eq $check_node} {
# The main site node is always checked
lappend check_list $check_node
- } elseif {[string equal [site_node::get_parent_id -node_id $check_node] $main_node] } {
+ } elseif {[site_node::get_parent_id -node_id $check_node] eq $main_node} {
# This node doesn't have a parent node, only the main site node
lappend check_list $check_node
Index: openacs-4/packages/acs-subsite/www/admin/site-map/application-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/site-map/application-new.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-subsite/www/admin/site-map/application-new.tcl 4 Jun 2006 00:45:45 -0000 1.4
+++ openacs-4/packages/acs-subsite/www/admin/site-map/application-new.tcl 10 Jan 2007 21:22:08 -0000 1.5
@@ -36,23 +36,23 @@
# Get the node ID of this subsite
set node_id [ad_conn node_id]
- if { [empty_string_p $instance_name] } {
+ if { $instance_name eq "" } {
# Find the package pretty name from the list of packages
foreach elm $packages {
- if { [string equal [lindex $elm 1] $package_key] } {
+ if {[lindex $elm 1] eq $package_key} {
set instance_name [lindex $elm 0]
break
}
}
- if { [empty_string_p $instance_name] } {
+ if { $instance_name eq "" } {
error "Couldn't find package_key '$package_key' in list of system applications"
}
}
# Autogenerate folder name
- if { [empty_string_p $folder] } {
+ if { $folder eq "" } {
set existing_urls [site_node::get_children -node_id $node_id -element name]
set folder [util_text_to_url \
Index: openacs-4/packages/acs-subsite/www/admin/site-map/auto-mount.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/site-map/auto-mount.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/admin/site-map/auto-mount.tcl 10 Sep 2002 22:22:11 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/admin/site-map/auto-mount.tcl 10 Jan 2007 21:22:08 -0000 1.4
@@ -16,7 +16,7 @@
subsite::auto_mount_application -node_id $node_id $package_key
-if {[empty_string_p $return_url]} {
+if {$return_url eq ""} {
set return_url [site_node::get_url -node_id]
}
Index: openacs-4/packages/acs-subsite/www/admin/site-map/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/site-map/index.tcl,v
diff -u -r1.23 -r1.24
--- openacs-4/packages/acs-subsite/www/admin/site-map/index.tcl 4 Jun 2006 00:45:45 -0000 1.23
+++ openacs-4/packages/acs-subsite/www/admin/site-map/index.tcl 10 Jan 2007 21:22:08 -0000 1.24
@@ -14,7 +14,7 @@
{rename_application:integer {}}
}
-if {[empty_string_p $root_id]} {
+if {$root_id eq ""} {
set root_id [ad_conn node_id]
}
@@ -28,15 +28,15 @@
set parent_id $node(parent_id)
set object_id $node(object_id)
-if {![empty_string_p $object_id]} {
+if {$object_id ne ""} {
ad_require_permission $object_id admin
}
-if {![empty_string_p $new_parent]} {
+if {$new_parent ne ""} {
set javascript "onLoad=\"javascript:document.new_parent.name.focus();document.new_parent.name.select()\""
-} elseif {![empty_string_p $new_application]} {
+} elseif {$new_application ne ""} {
set javascript "onLoad=\"javascript:document.new_application.instance_name.focus();document.new_application.instance_name.select()\""
-} elseif {![empty_string_p $rename_application]} {
+} elseif {$rename_application ne ""} {
set javascript "onLoad=\"javascript:document.rename_application.instance_name.focus();document.rename_application.instance_name.select()\""
} else {
set javascript ""
@@ -50,20 +50,20 @@
set user_id [ad_conn user_id]
db_foreach path_select {} {
- if {$node_id != $root_id && $admin_p == "t"} {
+ if {$node_id != $root_id && $admin_p eq "t"} {
append head "<a href=.?[export_url_vars expand:multiple root_id=$node_id]>"
}
- if {[empty_string_p $name]} {
+ if {$name eq ""} {
append head "$obj_name:"
} else {
append head $name
}
- if {$node_id != $root_id && $admin_p == "t"} {
+ if {$node_id != $root_id && $admin_p eq "t"} {
append head "</a>"
}
- if {$directory_p == "t"} {
+ if {$directory_p eq "t"} {
append head "/"
}
} if_no_rows {
@@ -72,7 +72,7 @@
if {[llength $expand] == 0} {
lappend expand $root_id
- if { ![empty_string_p $parent_id] } {
+ if { $parent_id ne "" } {
lappend expand $parent_id
}
}
@@ -194,11 +194,11 @@
set parameters_url ""
set permissions_url ""
- if { [lsearch -exact $open_nodes $parent_id] == -1 && $parent_id != "" && $mylevel > 2 } { continue }
+ if { [lsearch -exact $open_nodes $parent_id] == -1 && $parent_id ne "" && $mylevel > 2 } { continue }
- if {$directory_p == "t"} {
+ if {$directory_p eq "t"} {
set add_folder_url "?[export_url_vars expand:multiple root_id node_id new_parent=$node_id new_type=folder]"
- if {[empty_string_p $object_id]} {
+ if {$object_id eq ""} {
set mount_url "mount?[export_url_vars expand:multiple root_id node_id]"
set new_app_url "?[export_url_vars expand:multiple root_id new_application=$node_id]"
} else {
@@ -214,15 +214,15 @@
set delete_url "instance-delete?package_id=$object_id&root_id=$root_id"
}
# Is the object a package?
- if {![empty_string_p $package_id]} {
+ if {$package_id ne ""} {
if {$object_admin_p && ($parameter_count > 0)} {
set parameters_url "[export_vars -base "/shared/parameters" { package_id {return_url {[ad_return_url]} } }]"
}
}
}
}
- if {[ad_conn node_id] != $node_id && $n_children == 0 && [empty_string_p $object_id]} {
+ if {[ad_conn node_id] != $node_id && $n_children == 0 && $object_id eq ""} {
set delete_url "delete?[export_url_vars expand:multiple root_id node_id]"
}
@@ -261,7 +261,7 @@
set action_type 0
set action_form_part ""
- if {[empty_string_p $object_id]} {
+ if {$object_id eq ""} {
if {$new_application == $node_id} {
set action_type "new_app"
Index: openacs-4/packages/acs-subsite/www/admin/site-map/instance-delete.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/site-map/instance-delete.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-subsite/www/admin/site-map/instance-delete.tcl 12 Mar 2005 21:38:35 -0000 1.8
+++ openacs-4/packages/acs-subsite/www/admin/site-map/instance-delete.tcl 10 Jan 2007 21:22:08 -0000 1.9
@@ -32,11 +32,11 @@
-element url]
# node_id was null so we're not deleting a mounted subsite instance
- if {[empty_string_p $parent] } {
+ if {$parent eq "" } {
set parent [ad_conn subsite_url]
}
- if { ![empty_string_p $node_id] } {
+ if { $node_id ne "" } {
# The package is mounted
site_node::unmount -node_id $node_id
site_node::delete -node_id $node_id
Index: openacs-4/packages/acs-subsite/www/admin/site-map/package-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/site-map/package-new.tcl,v
diff -u -r1.11 -r1.12
--- openacs-4/packages/acs-subsite/www/admin/site-map/package-new.tcl 4 Jun 2006 00:45:45 -0000 1.11
+++ openacs-4/packages/acs-subsite/www/admin/site-map/package-new.tcl 10 Jan 2007 21:22:08 -0000 1.12
@@ -20,12 +20,12 @@
root_id:integer,optional
}
-if { [string equal $package_key "/new"] } {
+if {$package_key eq "/new"} {
ad_returnredirect "/acs-admin/apm/packages-install"
ad_script_abort
}
-if { [empty_string_p $instance_name] } {
+if { $instance_name eq "" } {
set instance_name [db_string instance_default_name "select pretty_name from apm_package_types where package_key = :package_key"]
}
@@ -36,7 +36,7 @@
set context_id [ad_conn package_id]
array set node [site_node::get -node_id $node_id]
- if { ![empty_string_p $node(object_id)] } {
+ if { $node(object_id) ne "" } {
set context_id $node(object_id)
}
Index: openacs-4/packages/acs-subsite/www/admin/site-map/parameter-set.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/site-map/Attic/parameter-set.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-subsite/www/admin/site-map/parameter-set.tcl 2 Jul 2003 17:57:31 -0000 1.8
+++ openacs-4/packages/acs-subsite/www/admin/site-map/parameter-set.tcl 10 Jan 2007 21:22:08 -0000 1.9
@@ -58,7 +58,7 @@
<hr>
"
-if { ![empty_string_p $dimensional_list] } {
+if { $dimensional_list ne "" } {
append body "[ad_dimensional $dimensional_list]<p>"
}
Index: openacs-4/packages/acs-subsite/www/admin/site-map/site-map.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/site-map/site-map.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/admin/site-map/site-map.tcl 19 Jan 2005 14:58:28 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/admin/site-map/site-map.tcl 10 Jan 2007 21:22:08 -0000 1.4
@@ -14,7 +14,7 @@
{rename_application:integer {}}
}
-if {[empty_string_p $root_id]} {
+if {$root_id eq ""} {
set root_id [ad_conn node_id]
}
@@ -28,15 +28,15 @@
set parent_id $node(parent_id)
set object_id $node(object_id)
-if {![empty_string_p $object_id]} {
+if {$object_id ne ""} {
ad_require_permission $object_id admin
}
-if {![empty_string_p $new_parent]} {
+if {$new_parent ne ""} {
set javascript "onLoad=\"javascript:document.new_parent.name.focus();document.new_parent.name.select()\""
-} elseif {![empty_string_p $new_application]} {
+} elseif {$new_application ne ""} {
set javascript "onLoad=\"javascript:document.new_application.instance_name.focus();document.new_application.instance_name.select()\""
-} elseif {![empty_string_p $rename_application]} {
+} elseif {$rename_application ne ""} {
set javascript "onLoad=\"javascript:document.rename_application.instance_name.focus();document.rename_application.instance_name.select()\""
} else {
set javascript ""
@@ -52,20 +52,20 @@
set user_id [ad_conn user_id]
db_foreach path_select {} {
- if {$node_id != $root_id && $admin_p == "t"} {
+ if {$node_id != $root_id && $admin_p eq "t"} {
append head "<a href=.?[export_url_vars expand:multiple root_id=$node_id]>"
}
- if {[empty_string_p $name]} {
+ if {$name eq ""} {
append head "$obj_name:"
} else {
append head $name
}
- if {$node_id != $root_id && $admin_p == "t"} {
+ if {$node_id != $root_id && $admin_p eq "t"} {
append head "</a>"
}
- if {$directory_p == "t"} {
+ if {$directory_p eq "t"} {
append head "/"
}
} if_no_rows {
@@ -74,7 +74,7 @@
if {[llength $expand] == 0} {
lappend expand $root_id
- if { ![empty_string_p $parent_id] } {
+ if { $parent_id ne "" } {
lappend expand $parent_id
}
}
@@ -180,11 +180,11 @@
set delete_url ""
set parameters_url ""
set permissions_url ""
- if { [lsearch -exact $open_nodes $parent_id] == -1 && $parent_id != "" && $mylevel > 2 } { continue }
+ if { [lsearch -exact $open_nodes $parent_id] == -1 && $parent_id ne "" && $mylevel > 2 } { continue }
- if {$directory_p == "t"} {
+ if {$directory_p eq "t"} {
set add_folder_url "?[export_url_vars expand:multiple root_id node_id new_parent=$node_id new_type=folder]"
- if {[empty_string_p $object_id]} {
+ if {$object_id eq ""} {
set mount_url "mount?[export_url_vars expand:multiple root_id node_id]"
set new_app_url "?[export_url_vars expand:multiple root_id new_application=$node_id]"
} else {
@@ -200,15 +200,15 @@
set delete_url "instance-delete?package_id=$object_id&root_id=$root_id"
}
# Is the object a package?
- if {![empty_string_p $package_id]} {
+ if {$package_id ne ""} {
if {$object_admin_p && ($parameter_count > 0)} {
set parameters_url "[export_vars -base "/shared/parameters" { package_id {return_url {[ad_return_url]} } }]"
}
}
}
}
- if {[ad_conn node_id] != $node_id && $n_children == 0 && [empty_string_p $object_id]} {
+ if {[ad_conn node_id] != $node_id && $n_children == 0 && $object_id eq ""} {
set delete_url "delete?[export_url_vars expand:multiple root_id node_id]"
}
@@ -252,7 +252,7 @@
set action_type 0
set action_form_part ""
- if {[empty_string_p $object_id]} {
+ if {$object_id eq ""} {
if {$new_application == $node_id} {
set action_type "new_app"
Index: openacs-4/packages/acs-subsite/www/admin/users/new.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/users/new.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-subsite/www/admin/users/new.tcl 29 Jun 2004 10:17:43 -0000 1.8
+++ openacs-4/packages/acs-subsite/www/admin/users/new.tcl 10 Jan 2007 21:22:08 -0000 1.9
@@ -51,8 +51,8 @@
# Membership relations have a member_state attribute that gets set
# based on the group's join policy.
-if {[string equal $ancestor_rel_type membership_rel]} {
- if {[string equal $add_to_group_join_policy "closed"] && !$create_p} {
+if {$ancestor_rel_type eq "membership_rel"} {
+ if {$add_to_group_join_policy eq "closed" && !$create_p} {
ad_complain "You do not have permission to add elements to $add_to_group_name"
return
}
@@ -86,7 +86,7 @@
## constraint violations in the database because the constraints are enforced
## by triggers in the DB.
-if { [string eq $user_type_exact_p "f"] && \
+if { $user_type_exact_p eq "f" && \
[subsite::util::sub_type_exists_p $user_type] } {
# Sub user-types exist... select one
@@ -150,7 +150,7 @@
set password [ad_generate_random_string]
- if {[empty_string_p $add_to_group_id]} {
+ if {$add_to_group_id eq ""} {
set add_to_group_id [application_group::group_id_from_package_id]
}
@@ -189,7 +189,7 @@
# Hack for adding users to the main subsite, whose application group is the registered users group.
if { $add_to_group_id != [acs_lookup_magic_object "registered_users"] ||
- ![string equal $add_with_rel_type "membership_rel"] } {
+ $add_with_rel_type ne "membership_rel" } {
relation_add -member_state $rel_member_state $add_with_rel_type $add_to_group_id $user_id
}
@@ -212,7 +212,7 @@
set return_url_stacked [subsite::util::return_url_stack $return_url_list]
- if {[empty_string_p $return_url_stacked]} {
+ if {$return_url_stacked eq ""} {
set return_url_stacked "../parties/one?party_id=$user_id"
}
ad_returnredirect $return_url_stacked
@@ -242,7 +242,7 @@
"
}
- if { $email_verified_p == "f" } {
+ if { $email_verified_p eq "f" } {
set row_id [db_string user_new_2_rowid_for_email "select rowid from users where user_id = :user_id"]
# the user has to come back and activate their account
Index: openacs-4/packages/acs-subsite/www/members/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/members/index.tcl,v
diff -u -r1.17 -r1.18
--- openacs-4/packages/acs-subsite/www/members/index.tcl 22 Jul 2005 00:32:25 -0000 1.17
+++ openacs-4/packages/acs-subsite/www/members/index.tcl 10 Jan 2007 21:22:08 -0000 1.18
@@ -157,7 +157,7 @@
# Pull out all the relations of the specified type
-set show_partial_email_p [expr $user_id == 0]
+set show_partial_email_p [expr {$user_id == 0}]
db_multirow -extend {
email_url
@@ -175,7 +175,7 @@
if { $member_admin_p > 0 } {
set rel_role_pretty [lang::util::localize $admin_role_pretty]
} else {
- if { ![empty_string_p $other_role_pretty] } {
+ if { $other_role_pretty ne "" } {
set rel_role_pretty [lang::util::localize $other_role_pretty]
} else {
set rel_role_pretty [lang::util::localize $member_role_pretty]
@@ -217,7 +217,7 @@
if { [ad_conn user_id] == 0 } {
set email [string replace $email \
- [expr [string first "@" $email]+3] end "..."]
+ [expr {[string first "@" $email]+3}] end "..."]
} else {
set email_url "mailto:$email"
}
Index: openacs-4/packages/acs-subsite/www/members/member-invite.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/members/member-invite.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-subsite/www/members/member-invite.tcl 30 Apr 2004 22:49:19 -0000 1.8
+++ openacs-4/packages/acs-subsite/www/members/member-invite.tcl 10 Jan 2007 21:22:09 -0000 1.9
@@ -40,7 +40,7 @@
ad_form -extend -name user_search -on_submit {
set create_p [group::permission_p -privilege create $group_id]
- if { [string equal $group_info(join_policy) "closed"] && !$create_p} {
+ if { $group_info(join_policy) eq "closed" && !$create_p} {
ad_return_forbidden "Cannot invite members" "I'm sorry, but you're not allowed to invite members to this group"
ad_script_abort
}
Index: openacs-4/packages/acs-subsite/www/members/user-batch-add-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/members/user-batch-add-2.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/members/user-batch-add-2.tcl 17 May 2004 15:14:53 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/members/user-batch-add-2.tcl 10 Jan 2007 21:22:09 -0000 1.4
@@ -29,7 +29,7 @@
while {[regexp {(.[^\n]+)} $userlist match_fodder row] } {
# remove each row as it's handled
set remove_count [string length $row]
- set userlist [string range $userlist [expr $remove_count + 1] end]
+ set userlist [string range $userlist [expr {$remove_count + 1}] end]
set row [split $row ,]
set email [string trim [lindex $row 0]]
set first_names [string trim [lindex $row 1]]
@@ -55,12 +55,12 @@
}
}
- if {![info exists first_names] || [empty_string_p $first_names]} {
+ if {![info exists first_names] || $first_names eq ""} {
append exception_text "<li> No first name in ($row)</li>\n"
continue
}
- if {![info exists last_name] || [empty_string_p $last_name]} {
+ if {![info exists last_name] || $last_name eq ""} {
append exception_text "<li> No last name in ($row)</li>\n"
continue
}
Index: openacs-4/packages/acs-subsite/www/members/user-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/members/user-new.tcl,v
diff -u -r1.7 -r1.8
--- openacs-4/packages/acs-subsite/www/members/user-new.tcl 20 Apr 2004 21:13:00 -0000 1.7
+++ openacs-4/packages/acs-subsite/www/members/user-new.tcl 10 Jan 2007 21:22:09 -0000 1.8
@@ -19,11 +19,11 @@
# Check if email is already known on the system
set party_id [db_string select_party { select party_id from parties where lower(email) = lower(:email) } -default {}]
-if { ![empty_string_p $party_id] } {
+if { $party_id ne "" } {
# Yes, is it a user?
set user_id [db_string select_user { select user_id from users where user_id = :party_id } -default {}]
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
# This is a party, but it's not a user
acs_object_type::get -object_type [acs_object_type $party_id] -array object_type
@@ -39,7 +39,7 @@
# Check to see if the user is a member of the main site (registered user)
set registered_user_id [db_string select_user { select user_id from cc_users where user_id = :party_id } -default {}]
- if { [empty_string_p $registered_user_id] } {
+ if { $registered_user_id eq "" } {
# User exists, but is not member of main site. Requires SW-admin to remedy.
if { [acs_user::site_wide_admin_p] } {
set main_site_id [site_node::get_element -url / -element object_id]
Index: openacs-4/packages/acs-subsite/www/permissions/grant.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/permissions/grant.tcl,v
diff -u -r1.13 -r1.14
--- openacs-4/packages/acs-subsite/www/permissions/grant.tcl 13 Jan 2005 13:55:50 -0000 1.13
+++ openacs-4/packages/acs-subsite/www/permissions/grant.tcl 10 Jan 2007 21:22:09 -0000 1.14
@@ -58,7 +58,7 @@
# find the end position up to where the block extends that we have
# to move
set end_pos $start_pos
- for { set i [expr $start_pos + 1] } { $i <= [llength $hierarchy] } { incr i } {
+ for { set i [expr {$start_pos + 1}] } { $i <= [llength $hierarchy] } { incr i } {
set level [lindex [lindex $hierarchy $i] 0]
if { $level <= $start_pos_level } {
break
@@ -88,7 +88,7 @@
# insert the block to the new position, looping through the block
foreach element $block_to_move {
incr target_pos
- set level_to_move [expr [lindex $element 0] + $target_level + 1 - $offset]
+ set level_to_move [expr {[lindex $element 0] + $target_level + 1 - $offset}]
set privilege_to_move [lindex $element 1]
set hierarchy [linsert $hierarchy $target_pos [list $level_to_move $privilege_to_move]]
@@ -156,7 +156,7 @@
foreach privilege $privileges {
# Lars: For some reason, selecting no privileges returns in a list
# containing one element, which is the empty string
- if { ![empty_string_p $privilege] } {
+ if { $privilege ne "" } {
permission::grant -party_id $party_id -object_id $object_id -privilege $privilege
}
}
Index: openacs-4/packages/acs-subsite/www/permissions/one.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/permissions/one.tcl,v
diff -u -r1.12 -r1.13
--- openacs-4/packages/acs-subsite/www/permissions/one.tcl 1 Mar 2005 00:01:24 -0000 1.12
+++ openacs-4/packages/acs-subsite/www/permissions/one.tcl 10 Jan 2007 21:22:09 -0000 1.13
@@ -19,7 +19,7 @@
# RBM: Check if this is the Main Site and prevent the user from being
# able to remove Read permission on "The Public" and locking
# him/herself out.
-if { [string equal $object_id [subsite::main_site_id]] } {
+if {$object_id eq [subsite::main_site_id]} {
set mainsite_p 1
} else {
set mainsite_p 0
@@ -42,7 +42,7 @@
db_1row context { *SQL* }
-if { $security_inherit_p == "t" && ![empty_string_p $context_id] } {
+if { $security_inherit_p eq "t" && $context_id ne "" } {
lappend controls "<a href=\"toggle-inherit?[export_vars {application_url object_id}]\">Don't Inherit Permissions from [ad_quotehtml $context_name]</a>"
} else {
lappend controls "<a href=\"toggle-inherit?[export_vars {application_url object_id}]\">Inherit Permissions from [ad_quotehtml $context_name]</a>"
@@ -55,7 +55,7 @@
set show_children_url "one?[export_vars {object_id application_url {children_p t}}]"
set hide_children_url "one?[export_vars {object_id application_url {children_p f}}]"
-if [string equal $children_p "t"] {
+if {$children_p eq "t"} {
db_multirow children children { *SQL* } {
}
} else {
Index: openacs-4/packages/acs-subsite/www/permissions/perm-include.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/permissions/perm-include.tcl,v
diff -u -r1.7 -r1.8
--- openacs-4/packages/acs-subsite/www/permissions/perm-include.tcl 4 Jun 2006 00:45:45 -0000 1.7
+++ openacs-4/packages/acs-subsite/www/permissions/perm-include.tcl 10 Jan 2007 21:22:09 -0000 1.8
@@ -74,7 +74,7 @@
[_ acs-subsite.Grant_Permission] "${perm_url}grant?[export_vars {return_url application_url object_id}]" [_ acs-subsite.Grant_Permission] \
[_ acs-subsite.Search_For_Exist_User] $user_add_url [_ acs-subsite.Search_For_Exist_User]]
-if { ![empty_string_p $context_id] } {
+if { $context_id ne "" } {
set inherit_p [permission::inherit_p -object_id $object_id]
if { $inherit_p } {
@@ -117,7 +117,7 @@
# We do not include site-wide admins in the list
db_multirow -extend { name_url } permissions permissions {} {
- if { [string equal $object_type "user"] && $grantee_id != 0 } {
+ if { $object_type eq "user" && $grantee_id != 0 } {
set name_url [acs_community_member_url -user_id $grantee_id]
}
}
Index: openacs-4/packages/acs-subsite/www/permissions/perm-modify.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/permissions/perm-modify.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-subsite/www/permissions/perm-modify.tcl 28 Aug 2003 09:41:41 -0000 1.2
+++ openacs-4/packages/acs-subsite/www/permissions/perm-modify.tcl 10 Jan 2007 21:22:09 -0000 1.3
@@ -14,7 +14,7 @@
set elmv [split $elm ","]
set party_id [lindex $elmv 0]
set priv [lindex $elmv 1]
- if { ![string equal $priv "remove"] } {
+ if { $priv ne "remove" } {
set perm_array($elm) add
}
}
@@ -23,7 +23,7 @@
set elmv [split $elm ","]
set party_id [lindex $elmv 0]
set priv [lindex $elmv 1]
- if { [string equal $priv "remove"] } {
+ if {$priv eq "remove"} {
foreach priv $privs {
if { [info exists perm_array(${party_id},${priv})] } {
unset perm_array(${party_id},${priv})
Index: openacs-4/packages/acs-subsite/www/permissions/revoke-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/permissions/revoke-2.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-subsite/www/permissions/revoke-2.tcl 17 May 2003 10:02:04 -0000 1.4
+++ openacs-4/packages/acs-subsite/www/permissions/revoke-2.tcl 10 Jan 2007 21:22:09 -0000 1.5
@@ -14,7 +14,7 @@
permission::require_permission -object_id $object_id -privilege admin
-if { [string eq $operation "Yes"] } {
+if {$operation eq "Yes"} {
db_transaction {
foreach item $revoke_list {
set party_id [lindex $item 0]
Index: openacs-4/packages/acs-subsite/www/pvt/alerts.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/pvt/alerts.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-subsite/www/pvt/alerts.tcl 1 Mar 2005 00:01:24 -0000 1.4
+++ openacs-4/packages/acs-subsite/www/pvt/alerts.tcl 10 Jan 2007 21:22:09 -0000 1.5
@@ -16,7 +16,7 @@
db_1row name_get "select first_names, last_name, email, url from persons, parties where persons.person_id = parties.party_id and party_id =:user_id" -bind [ad_tcl_vars_to_ns_set user_id]
-if { ![empty_string_p $first_names] || ![empty_string_p $last_name] } {
+if { $first_names ne "" || $last_name ne "" } {
set full_name "$first_names $last_name"
} else {
set full_name "name unknown"
@@ -49,7 +49,7 @@
order by bea.frequency" {
incr rownum
- if { $valid_p == "f" } {
+ if { $valid_p eq "f" } {
# alert has been disabled for some reason
set bboard_rows:$rownum(status) "disable"
set bboard_rows:$rownum(action_url) "/bboard/alert-reenable?rowid=[ns_urlencode $rowid]"
@@ -91,7 +91,7 @@
order by expires desc" {
incr rownum
- if { $valid_p == "f" } {
+ if { $valid_p eq "f" } {
# alert has been disabled for some reason
set classified_rows:$rownum(status) "Off"
set classified_rows:$rownum(action) "<a href=\"/gc/alert-reenable?alert_id=$alert_id\">Re-enable</a>"
@@ -101,11 +101,11 @@
set classified_rows:$rownum(action) "<a href=\"/gc/alert-disable?rowid=$rowid\">Disable</a>"
}
- if { $alert_type == "all" } {
+ if { $alert_type eq "all" } {
set classified_rows:$rownum(alert_value) "--"
- } elseif { $alert_type == "keywords" } {
+ } elseif { $alert_type eq "keywords" } {
set classified_rows:$rownum(alert_value) $keywords
- } elseif { $alert_type == "category" } {
+ } elseif { $alert_type eq "category" } {
set classified_rows:$rownum(alert_value) $category
} else {
# I don't know what to do here...
Index: openacs-4/packages/acs-subsite/www/pvt/home.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/pvt/home.tcl,v
diff -u -r1.21 -r1.22
--- openacs-4/packages/acs-subsite/www/pvt/home.tcl 4 Jun 2006 00:45:45 -0000 1.21
+++ openacs-4/packages/acs-subsite/www/pvt/home.tcl 10 Jan 2007 21:22:09 -0000 1.22
@@ -53,20 +53,20 @@
-if [ad_parameter SolicitPortraitP "user-info" 0] {
+if {[ad_parameter SolicitPortraitP "user-info" 0]} {
# we have portraits for some users
- if ![db_0or1row get_portrait_info "
+ if {![db_0or1row get_portrait_info "
select cr.publish_date, nvl(cr.title,'your portrait') as portrait_title,
nvl(cr.description,'no description') as portrait_description
from cr_revisions cr, cr_items ci, acs_rels a
where cr.revision_id = ci.live_revision
and ci.item_id = a.object_id_two
and a.object_id_one = :user_id
and a.rel_type = 'user_portrait_rel'
- "] {
+ "]} {
set portrait_state "upload"
} else {
- if { [empty_string_p $portrait_title] } {
+ if { $portrait_title eq "" } {
set portrait_title "[_ acs-subsite.no_portrait_title_message]"
}
Index: openacs-4/packages/acs-subsite/www/pvt/set-on-vacation-to-null.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/pvt/Attic/set-on-vacation-to-null.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/pvt/set-on-vacation-to-null.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/pvt/set-on-vacation-to-null.tcl 10 Jan 2007 21:22:09 -0000 1.2
@@ -15,7 +15,7 @@
select no_alerts_until from users where user_id = :user_id
} -default ""]
-if { ![empty_string_p $no_alerts_until] } {
+if { $no_alerts_until ne "" } {
set clear [db_null]
db_dml pvt_unset_no_alerts_until {
update users
Index: openacs-4/packages/acs-subsite/www/register/auto-login.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/register/auto-login.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/register/auto-login.tcl 25 Feb 2004 10:48:48 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/register/auto-login.tcl 10 Jan 2007 21:22:09 -0000 1.2
@@ -14,7 +14,7 @@
-email [string trim $email] \
-password $password]
-if { [string equal $auth_info(auth_status) "ok"] } {
+if {$auth_info(auth_status) eq "ok"} {
ad_returnredirect $return_url
ad_script_abort
} else {
Index: openacs-4/packages/acs-subsite/www/register/email-confirm.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/register/email-confirm.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-subsite/www/register/email-confirm.tcl 25 Mar 2005 23:59:10 -0000 1.9
+++ openacs-4/packages/acs-subsite/www/register/email-confirm.tcl 10 Jan 2007 21:22:09 -0000 1.10
@@ -7,7 +7,7 @@
}
if {![db_0or1row userp {select 1 from users where user_id = :user_id}]
- || ![string equal $token [auth::get_user_secret_token -user_id $user_id]] } {
+ || $token ne [auth::get_user_secret_token -user_id $user_id] } {
set title "Bad token"
set message "The link given to authenticate your email was invalid."
ad_return_template /packages/acs-subsite/lib/message
Index: openacs-4/packages/acs-subsite/www/register/logout.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/register/logout.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/register/logout.tcl 16 Oct 2003 20:44:58 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/register/logout.tcl 10 Jan 2007 21:22:09 -0000 1.4
@@ -9,7 +9,7 @@
{return_url ""}
}
-if { [empty_string_p $return_url] } {
+if { $return_url eq "" } {
if { [permission::permission_p -object_id [subsite::get_element -element package_id] -party_id 0 -privilege read] } {
set return_url [subsite::get_element -element url]
} else {
Index: openacs-4/packages/acs-subsite/www/register/user-join.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/register/user-join.tcl,v
diff -u -r1.11 -r1.12
--- openacs-4/packages/acs-subsite/www/register/user-join.tcl 4 Jun 2006 00:45:46 -0000 1.11
+++ openacs-4/packages/acs-subsite/www/register/user-join.tcl 10 Jan 2007 21:22:09 -0000 1.12
@@ -40,7 +40,7 @@
set ret_link ""
}
-if { [string equal $join_policy closed] } {
+if {$join_policy eq "closed"} {
ad_return_error [_ acs-subsite.Closed_group] "[_ acs-subsite.This_group_is_closed]<p>$ret_link"
ad_script_abort
}
@@ -64,7 +64,7 @@
set required_seg [multirow get required_segments $rownum]
if { ![group::member_p -group_id $required_segments(group_id)] } {
- if { [string equal $required_segments(join_policy) "closed"] } {
+ if {$required_segments(join_policy) eq "closed"} {
ad_return_error [_ acs-subsite.Closed_group] "[_ acs-subsite.This_group_is_closed]<p>$ret_link"
ad_script_abort
}
@@ -151,12 +151,12 @@
if { [permission::permission_p -object_id $group_id -privilege "admin"] } {
set member_state "approved"
- if { [string equal $rel_type "membership_rel"] } {
+ if {$rel_type eq "membership_rel"} {
# If they already have admin, bump them to an admin_rel
set rel_type "admin_rel"
}
} else {
- if { [string equal $join_policy "needs approval"] } {
+ if {$join_policy eq "needs approval"} {
set member_state "needs approval"
} else {
set member_state "approved"
Index: openacs-4/packages/acs-subsite/www/register/user-new.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/register/user-new.tcl,v
diff -u -r1.19 -r1.20
--- openacs-4/packages/acs-subsite/www/register/user-new.tcl 6 Oct 2006 13:20:57 -0000 1.19
+++ openacs-4/packages/acs-subsite/www/register/user-new.tcl 10 Jan 2007 21:22:10 -0000 1.20
@@ -8,6 +8,6 @@
}
set registration_url [parameter::get -parameter RegistrationRedirectUrl]
-if {![string eq "" $registration_url]} {
+if {$registration_url ne ""} {
ad_returnredirect $registration_url
}
\ No newline at end of file
Index: openacs-4/packages/acs-subsite/www/shared/community-member.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/shared/community-member.tcl,v
diff -u -r1.13 -r1.14
--- openacs-4/packages/acs-subsite/www/shared/community-member.tcl 13 Jan 2005 23:37:06 -0000 1.13
+++ openacs-4/packages/acs-subsite/www/shared/community-member.tcl 10 Jan 2007 21:22:10 -0000 1.14
@@ -29,7 +29,7 @@
#See if this page has been overrided by a parameter in kernel
set community_member_url [ad_parameter -package_id [ad_acs_kernel_id] CommunityMemberURL "/shared/community-member"]
-if { $community_member_url != "/shared/community-member" } {
+if { $community_member_url ne "/shared/community-member" } {
ad_returnredirect "$community_member_url?user_id=$user_id"
ad_script_abort
}
@@ -40,7 +40,7 @@
set verified_user_id [ad_conn user_id]
set untrusted_user_id [ad_conn untrusted_user_id]
-if { [empty_string_p $user_id] } {
+if { $user_id eq "" } {
if { $verified_user_id == 0 } {
# Don't know what to do!
ad_return_error "Missing user_id" "We need a user_id to display the community page"
@@ -65,7 +65,7 @@
set email_image "<p><b>\#acs-subsite.E_mail\#:</b> [email_image::get_user_email -user_id $user_id]</p>"
-if { ![empty_string_p $url] && ![string match -nocase "http://*" $url] } {
+if { $url ne "" && ![string match -nocase "http://*" $url] } {
set url "http://$url"
}
@@ -75,18 +75,18 @@
set inline_portrait_state "none"
set portrait_export_vars [export_url_vars user_id]
-if [db_0or1row portrait_info "
+if {[db_0or1row portrait_info "
select i.width, i.height, cr.title, cr.description, cr.publish_date
from acs_rels a, cr_items c, cr_revisions cr, images i
where a.object_id_two = c.item_id
and c.live_revision = cr.revision_id
and cr.revision_id = i.image_id
and a.object_id_one = :user_id
-and a.rel_type = 'user_portrait_rel'"] {
+and a.rel_type = 'user_portrait_rel'"]} {
# We have a portrait. Let's see if we can show it inline
- if { ![empty_string_p $width] && $width < 300 } {
+ if { $width ne "" && $width < 300 } {
# let's show it inline
set inline_portrait_state "inline"
} else {
Index: openacs-4/packages/acs-subsite/www/shared/parameters.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/shared/parameters.tcl,v
diff -u -r1.11 -r1.12
--- openacs-4/packages/acs-subsite/www/shared/parameters.tcl 4 Jun 2006 00:45:46 -0000 1.11
+++ openacs-4/packages/acs-subsite/www/shared/parameters.tcl 10 Jan 2007 21:22:10 -0000 1.12
@@ -22,9 +22,9 @@
set page_title "$instance_name Parameters"
-if { [string equal $package_url [subsite::get_element -element url]] } {
+if {$package_url eq [subsite::get_element -element url]} {
set context [list [list "${package_url}admin/" "Administration"] $page_title]
-} elseif { ![empty_string_p $package_url] } {
+} elseif { $package_url ne "" } {
set context [list [list $package_url $instance_name] [list "${package_url}admin/" "Administration"] $page_title]
} else {
set context [list $page_title]
@@ -41,14 +41,14 @@
set display_warning_p 0
set counter 0
set focus_elm {}
-if {![empty_string_p $section]} {
+if {$section ne ""} {
set section_where_clause [db_map section_where_clause]
} else {
set section_where_clause ""
}
db_foreach select_params {} {
- if { [empty_string_p $section_name] } {
+ if { $section_name eq "" } {
set section_name "Main"
} else {
set section_name [string map {_ { } - { }} $section_name]
@@ -66,7 +66,7 @@
{html {size 50}}]
set file_val [ad_parameter_from_file $parameter_name $package_key]
- if { ![empty_string_p $file_val] } {
+ if { $file_val ne "" } {
set display_warning_p 1
lappend elm [list after_html "<br><span style=\"color: red; font-weight: bold;\">$file_val (*)</span>"]
}
Index: openacs-4/packages/acs-subsite/www/shared/portrait-bits.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/shared/portrait-bits.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/shared/portrait-bits.tcl 2 Nov 2006 06:37:43 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/shared/portrait-bits.tcl 10 Jan 2007 21:22:10 -0000 1.4
@@ -14,11 +14,11 @@
return
}
-if {[empty_string_p $size]} {
+if {$size eq ""} {
cr_write_content -item_id $item_id
} else {
set thumbnail_id [image::get_resized_item_id -item_id $item_id -size_name $size]
- if {[empty_string_p $thumbnail_id]} {
+ if {$thumbnail_id eq ""} {
set thumbnail_id [image::resize -item_id $item_id -size_name $size]
}
cr_write_content -item_id $thumbnail_id
Index: openacs-4/packages/acs-subsite/www/shared/portrait-thumbnail-bits.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/shared/Attic/portrait-thumbnail-bits.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-subsite/www/shared/portrait-thumbnail-bits.tcl 2 Nov 2006 06:37:43 -0000 1.2
+++ openacs-4/packages/acs-subsite/www/shared/portrait-thumbnail-bits.tcl 10 Jan 2007 21:22:10 -0000 1.3
@@ -19,12 +19,12 @@
where user_id = $user_id
and portrait_thumbnail is not null"]
-if { [empty_string_p $file_type] } {
+if { $file_type eq "" } {
# Try to get a regular portrait
set file_type [db_string -default "" unused "select portrait_file_type
from users
where user_id = $user_id"]
- if [empty_string_p $file_type] {
+ if {$file_type eq ""} {
ad_return_error "Couldn't find thumbnail or portrait" "Couldn't find a thumbnail or a portrait for User $user_id"
return
}
Index: openacs-4/packages/acs-subsite/www/shared/portrait.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/shared/portrait.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-subsite/www/shared/portrait.tcl 13 Jan 2005 13:55:50 -0000 1.6
+++ openacs-4/packages/acs-subsite/www/shared/portrait.tcl 10 Jan 2007 21:22:10 -0000 1.7
@@ -18,27 +18,27 @@
set subsite_url [subsite::get_element -element url]
-if ![db_0or1row user_info "select
+if {![db_0or1row user_info "select
first_names,
last_name
from persons
-where person_id=:user_id"] {
+where person_id=:user_id"]} {
ad_return_error "Account Unavailable" "We can't find user #$user_id in the users table."
return
}
-if ![db_0or1row get_item_id "select i.width, i.height, cr.title, cr.description, cr.publish_date
+if {![db_0or1row get_item_id "select i.width, i.height, cr.title, cr.description, cr.publish_date
from acs_rels a, cr_items c, cr_revisions cr, images i
where a.object_id_two = c.item_id
and c.live_revision = cr.revision_id
and cr.revision_id = i.image_id
and a.object_id_one = :user_id
-and a.rel_type = 'user_portrait_rel'"] {
+and a.rel_type = 'user_portrait_rel'"]} {
ad_return_complaint 1 "<li>You shouldn't have gotten here; we don't have a portrait on file for this person."
return
}
-if { ![empty_string_p $width] && ![empty_string_p $height] } {
+if { $width ne "" && $height ne "" } {
set widthheight_param "width=$width height=$height"
} else {
set widthheight_param ""
Index: openacs-4/packages/acs-subsite/www/shared/send-email.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/shared/send-email.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-subsite/www/shared/send-email.tcl 14 Jan 2005 14:49:40 -0000 1.5
+++ openacs-4/packages/acs-subsite/www/shared/send-email.tcl 10 Jan 2007 21:22:10 -0000 1.6
@@ -14,7 +14,7 @@
set context [list [list [ad_pvt_home] [ad_pvt_home_name]] "Send Email"]
-if {[string equal $return_url ""]} {
+if {$return_url eq ""} {
set return_url [ad_pvt_home]
}
@@ -42,16 +42,16 @@
}
} -on_submit {
set to [email_image::get_email -user_id $sendto]
- if [catch {ns_sendmail "$to" "$from" "$subject" "$body"} errmsg] {
+ if {[catch {ns_sendmail "$to" "$from" "$subject" "$body"} errmsg]} {
ad_return_error "Mail Failed" "The system was unable to send email. Please notify the user personally. \
This problem is probably caused by a misconfiguration of your email system. Here is the error:
<blockquote><pre>
[ad_quotehtml $errmsg]
</pre></blockquote>"
return
}
- if { [string equal $copy 1]} {
- if [catch {ns_sendmail "$from" "$from" "$subject" "$body"} errmsg] {
+ if {$copy eq "1"} {
+ if {[catch {ns_sendmail "$from" "$from" "$subject" "$body"} errmsg]} {
ad_return_error "Mail Failed" "The system was unable to send email. Please notify the user personally. \
This problem is probably caused by a misconfiguration of your email system. Here is the error:
<blockquote><pre>
Index: openacs-4/packages/acs-subsite/www/shared/session-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/shared/session-update.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-subsite/www/shared/session-update.tcl 10 Sep 2002 22:22:13 -0000 1.2
+++ openacs-4/packages/acs-subsite/www/shared/session-update.tcl 10 Jan 2007 21:22:10 -0000 1.3
@@ -25,7 +25,7 @@
return_url
} -validate {
referrer_error {
- if { ![string equal $session_property(referrer) [get_referrer]] } {
+ if { $session_property(referrer) ne [get_referrer] } {
ad_complain "Expected referrer does not match actual referrer"
}
}
Index: openacs-4/packages/acs-subsite/www/shared/whos-online.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/shared/whos-online.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-subsite/www/shared/whos-online.tcl 16 Feb 2004 14:48:15 -0000 1.8
+++ openacs-4/packages/acs-subsite/www/shared/whos-online.tcl 10 Jan 2007 21:22:10 -0000 1.9
@@ -34,7 +34,7 @@
foreach user_id [whos_online::user_ids] {
acs_user::get -user_id $user_id -array user
- set first_request_minutes [expr [whos_online::seconds_since_first_request $user_id] / 60]
+ set first_request_minutes [expr {[whos_online::seconds_since_first_request $user_id] / 60}]
lappend users [list \
"$user(first_names) $user(last_name)" \
Index: openacs-4/packages/acs-subsite/www/site-map/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/site-map/index.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-subsite/www/site-map/index.tcl 24 Feb 2005 13:33:01 -0000 1.4
+++ openacs-4/packages/acs-subsite/www/site-map/index.tcl 10 Jan 2007 21:22:10 -0000 1.5
@@ -14,7 +14,7 @@
{rename_application:integer {}}
}
-if {[empty_string_p $root_id]} {
+if {$root_id eq ""} {
set root_id [ad_conn node_id]
}
@@ -26,11 +26,11 @@
set parent_id $node(parent_id)
set object_id $node(object_id)
-if {![empty_string_p $new_parent]} {
+if {$new_parent ne ""} {
set javascript "onLoad=\"javascript:document.new_parent.name.focus();document.new_parent.name.select()\""
-} elseif {![empty_string_p $new_application]} {
+} elseif {$new_application ne ""} {
set javascript "onLoad=\"javascript:document.new_application.instance_name.focus();document.new_application.instance_name.select()\""
-} elseif {![empty_string_p $rename_application]} {
+} elseif {$rename_application ne ""} {
set javascript "onLoad=\"javascript:document.rename_application.instance_name.focus();document.rename_application.instance_name.select()\""
} else {
set javascript ""
@@ -46,20 +46,20 @@
set user_id [ad_conn user_id]
db_foreach path_select {} {
- if {$node_id != $root_id && $admin_p == "t"} {
+ if {$node_id != $root_id && $admin_p eq "t"} {
append head "<a href=.?[export_url_vars expand:multiple root_id=$node_id]>"
}
- if {[empty_string_p $name]} {
+ if {$name eq ""} {
append head "$obj_name:"
} else {
append head $name
}
- if {$node_id != $root_id && $admin_p == "t"} {
+ if {$node_id != $root_id && $admin_p eq "t"} {
append head "</a>"
}
- if {$directory_p == "t"} {
+ if {$directory_p eq "t"} {
append head "/"
}
} if_no_rows {
@@ -68,7 +68,7 @@
if {[llength $expand] == 0} {
lappend expand $root_id
- if { ![empty_string_p $parent_id] } {
+ if { $parent_id ne "" } {
lappend expand $parent_id
}
}
@@ -145,11 +145,11 @@
set parameters_url ""
set permissions_url ""
- if { [lsearch -exact $open_nodes $parent_id] == -1 && $parent_id != "" && $mylevel > 2 } { continue }
+ if { [lsearch -exact $open_nodes $parent_id] == -1 && $parent_id ne "" && $mylevel > 2 } { continue }
- if {$directory_p == "t"} {
+ if {$directory_p eq "t"} {
set add_folder_url "?[export_url_vars expand:multiple root_id node_id new_parent=$node_id new_type=folder]"
- if {[empty_string_p $object_id]} {
+ if {$object_id eq ""} {
set mount_url "mount?[export_url_vars expand:multiple root_id node_id]"
set new_app_url "?[export_url_vars expand:multiple root_id new_application=$node_id]"
} else {
@@ -165,15 +165,15 @@
set delete_url "instance-delete?package_id=$object_id&root_id=$root_id"
}
# Is the object a package?
- if {![empty_string_p $package_id]} {
+ if {$package_id ne ""} {
if {$object_admin_p && ($parameter_count > 0)} {
set parameters_url "[export_vars -base "/shared/parameters" { package_id {return_url {[ad_return_url]} } }]"
}
}
}
}
- if {[ad_conn node_id] != $node_id && $n_children == 0 && [empty_string_p $object_id]} {
+ if {[ad_conn node_id] != $node_id && $n_children == 0 && $object_id eq ""} {
set delete_url "delete?[export_url_vars expand:multiple root_id node_id]"
}
@@ -222,7 +222,7 @@
set action_type 0
set action_form_part ""
- if {[empty_string_p $object_id]} {
+ if {$object_id eq ""} {
if {$new_application == $node_id} {
set action_type "new_app"
Index: openacs-4/packages/acs-subsite/www/user/basic-info-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/user/basic-info-update.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-subsite/www/user/basic-info-update.tcl 20 Apr 2004 21:13:03 -0000 1.9
+++ openacs-4/packages/acs-subsite/www/user/basic-info-update.tcl 10 Jan 2007 21:22:10 -0000 1.10
@@ -14,7 +14,7 @@
set page_title [_ acs-subsite._Update_Basic_Information]
-if { [empty_string_p $user_id] || ($user_id == [ad_conn untrusted_user_id]) } {
+if { $user_id eq "" || ($user_id == [ad_conn untrusted_user_id]) } {
set context [list [list [ad_pvt_home] [ad_pvt_home_name]] $page_title]
} else {
set context [list $page_title]
Index: openacs-4/packages/acs-subsite/www/user/email-privacy-level.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/user/email-privacy-level.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/user/email-privacy-level.tcl 14 Jan 2005 14:52:03 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/user/email-privacy-level.tcl 10 Jan 2007 21:22:11 -0000 1.2
@@ -9,7 +9,7 @@
set page_title "\"#acs-subsite.Change_my_email_P\#\""
set context [list [list [ad_pvt_home] [ad_pvt_home_name]] $page_title]
-if { [string equal $user_id ""] } {
+if {$user_id eq ""} {
set user_id [auth::require_login -account_status closed]
}
Index: openacs-4/packages/acs-subsite/www/user/password-reset.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/user/password-reset.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-subsite/www/user/password-reset.tcl 19 Oct 2006 12:54:57 -0000 1.1
+++ openacs-4/packages/acs-subsite/www/user/password-reset.tcl 10 Jan 2007 21:22:11 -0000 1.2
@@ -86,7 +86,7 @@
}
} -after_submit {
- if { [empty_string_p $return_url] } {
+ if { $return_url eq "" } {
set return_url [ad_pvt_home]
set pvt_home_name [ad_pvt_home_name]
set continue_label [_ acs-subsite.Continue_to_your_account]
Index: openacs-4/packages/acs-subsite/www/user/password-update.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/user/password-update.tcl,v
diff -u -r1.20 -r1.21
--- openacs-4/packages/acs-subsite/www/user/password-update.tcl 27 Feb 2004 16:02:31 -0000 1.20
+++ openacs-4/packages/acs-subsite/www/user/password-update.tcl 10 Jan 2007 21:22:11 -0000 1.21
@@ -18,7 +18,7 @@
security::require_secure_conn
}
-if { ![empty_string_p $old_password] } {
+if { $old_password ne "" } {
# If old_password is set, this is a user who has had his password recovered,
# so they won't be authenticated yet.
} else {
@@ -162,12 +162,12 @@
}
# If the account was closed, it might be open now
- if { [string equal [ad_conn account_status] "closed"] } {
+ if {[ad_conn account_status] eq "closed"} {
auth::verify_account_status
}
} -after_submit {
- if { [empty_string_p $return_url] } {
+ if { $return_url eq "" } {
set return_url [ad_pvt_home]
set pvt_home_name [ad_pvt_home_name]
set continue_label [_ acs-subsite.Continue_to_your_account]
Index: openacs-4/packages/acs-subsite/www/user/portrait/comment-edit-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/user/portrait/Attic/comment-edit-2.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/user/portrait/comment-edit-2.tcl 1 Mar 2005 00:01:24 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/user/portrait/comment-edit-2.tcl 10 Jan 2007 21:22:11 -0000 1.4
@@ -12,7 +12,7 @@
set current_user_id [ad_conn user_id]
-if [empty_string_p $user_id] {
+if {$user_id eq ""} {
set user_id $current_user_id
set admin_p 0
} else {
@@ -35,7 +35,7 @@
and a.object_id_one = :user_id
and a.rel_type = 'user_portrait_rel')"
-if { ![empty_string_p $return_url] } {
+if { $return_url ne "" } {
ad_returnredirect $return_url
} else {
ad_returnredirect [ad_pvt_home]
Index: openacs-4/packages/acs-subsite/www/user/portrait/comment-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/user/portrait/comment-edit.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/user/portrait/comment-edit.tcl 1 Mar 2005 00:01:24 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/user/portrait/comment-edit.tcl 10 Jan 2007 21:22:11 -0000 1.4
@@ -17,7 +17,7 @@
set current_user_id [ad_conn user_id]
-if [empty_string_p $user_id] {
+if {$user_id eq ""} {
set user_id $current_user_id
set admin_p 0
} else {
@@ -26,23 +26,23 @@
ad_require_permission $user_id "write"
-if ![db_0or1row user_info "select
+if {![db_0or1row user_info "select
first_names,
last_name
from persons
-where person_id = :user_id"] {
+where person_id = :user_id"]} {
ad_return_error "Account Unavailable" "We can't find you (user #$user_id) in the users table. Probably your account was deleted for some reason."
return
}
-if ![db_0or1row portrait_info "
+if {![db_0or1row portrait_info "
select description
from cr_revisions
where revision_id = (select live_revision
from cr_items c, acs_rels a
where c.item_id = a.object_id_two
and a.object_id_one = :user_id
- and a.rel_type = 'user_portrait_rel')"] {
+ and a.rel_type = 'user_portrait_rel')"]} {
ad_return_complaint 1 "<li>You shouldn't have gotten here; we don't have a portrait on file for you."
return
}
Index: openacs-4/packages/acs-subsite/www/user/portrait/erase-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/user/portrait/Attic/erase-2.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-subsite/www/user/portrait/erase-2.tcl 1 Mar 2005 00:01:24 -0000 1.3
+++ openacs-4/packages/acs-subsite/www/user/portrait/erase-2.tcl 10 Jan 2007 21:22:11 -0000 1.4
@@ -15,7 +15,7 @@
set current_user_id [ad_conn user_id]
-if [empty_string_p $user_id] {
+if {$user_id eq ""} {
set user_id $current_user_id
set admin_p 0
} else {
@@ -32,7 +32,7 @@
where object_id_one = :user_id
and rel_type = 'user_portrait_rel')"
-if [empty_string_p $return_url] {
+if {$return_url eq ""} {
set return_url "/pvt/home"
}
Index: openacs-4/packages/acs-subsite/www/user/portrait/erase.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/user/portrait/erase.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-subsite/www/user/portrait/erase.tcl 1 Mar 2005 00:01:24 -0000 1.4
+++ openacs-4/packages/acs-subsite/www/user/portrait/erase.tcl 10 Jan 2007 21:22:11 -0000 1.5
@@ -13,7 +13,7 @@
set current_user_id [ad_conn user_id]
-if [empty_string_p $user_id] {
+if {$user_id eq ""} {
set user_id $current_user_id
set admin_p 0
} else {
Index: openacs-4/packages/acs-subsite/www/user/portrait/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/user/portrait/index.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-subsite/www/user/portrait/index.tcl 1 Mar 2005 00:01:24 -0000 1.8
+++ openacs-4/packages/acs-subsite/www/user/portrait/index.tcl 10 Jan 2007 21:22:11 -0000 1.9
@@ -34,7 +34,7 @@
# no_portrait : No portrait uploaded yet for this user.
# no_portrait_info : Unable to retrieve information on portrait.
-if [empty_string_p $user_id] {
+if {$user_id eq ""} {
set user_id $current_user_id
}
@@ -48,11 +48,11 @@
set export_vars [export_url_vars user_id]
set export_edit_vars [export_url_vars user_id return_url]
-if ![db_0or1row user_info "select
+if {![db_0or1row user_info "select
first_names,
last_name
from persons
-where person_id=:user_id"] {
+where person_id=:user_id"]} {
set return_code "no_user"
set context [list "Account Unavailable"]
ad_return_template
@@ -64,7 +64,7 @@
from acs_rels a, cr_items c
where a.object_id_two = c.item_id
and a.object_id_one = :user_id
-and a.rel_type = 'user_portrait_rel'"] || [empty_string_p $revision_id]} {
+and a.rel_type = 'user_portrait_rel'"] || $revision_id eq ""} {
# The user doesn't have a portrait yet
set portrait_p 0
} else {
@@ -87,25 +87,25 @@
# we have revision_id now
-if [catch {db_1row get_picture_info "
+if {[catch {db_1row get_picture_info "
select i.width, i.height, cr.title, cr.description, cr.publish_date
from images i, cr_revisions cr
where i.image_id = cr.revision_id
and image_id = :revision_id
-"} errmsg] {
+"} errmsg]} {
# There was an error obtaining the picture information
set context [list "Invalid Picture"]
set return_code "no_portrait_info"
ad_return_template
return
}
-if [empty_string_p $publish_date] {
+if {$publish_date eq ""} {
ad_return_complaint 1 "<li>You shouldn't have gotten here; we don't have a portrait on file for you."
return
}
-if { ![empty_string_p $width] && ![empty_string_p $height] } {
+if { $width ne "" && $height ne "" } {
set widthheight "width=$width height=$height"
} else {
set widthheight ""
Index: openacs-4/packages/acs-subsite/www/user/portrait/upload-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/user/portrait/Attic/upload-2.tcl,v
diff -u -r1.13 -r1.14
--- openacs-4/packages/acs-subsite/www/user/portrait/upload-2.tcl 15 Dec 2006 17:25:30 -0000 1.13
+++ openacs-4/packages/acs-subsite/www/user/portrait/upload-2.tcl 10 Jan 2007 21:22:11 -0000 1.14
@@ -15,7 +15,7 @@
subsite::upload_allowed
set current_user_id [auth::require_login]
-if [empty_string_p $user_id] {
+if {$user_id eq ""} {
set user_id $current_user_id
}
@@ -25,7 +25,7 @@
set exception_count 0
if {![info exists upload_file]
- || [empty_string_p $upload_file]
+ || $upload_file eq ""
} {
append exception_text "<li>Please specify a file to upload</li>\n"
incr exception_count
@@ -78,7 +78,7 @@
db_transaction {
set item_id [content::item::get_id_by_name -name "portrait-of-user-$user_id" -parent_id $user_id]
- if { [empty_string_p $item_id]} {
+ if { $item_id eq ""} {
# The user doesn't have a portrait relation yet
set item_id [content::item::new -name "portrait-of-user-$user_id" -parent_id $user_id -content_type image]
}
@@ -100,7 +100,7 @@
content::item::set_live_revision -revision_id $revision_id
# Only create the new relationship if there does not exist one already
set user_portrait_rel_id [relation::get_id -object_id_one $user_id -object_id_two $item_id -rel_type "user_portrait_rel"]
- if {[empty_string_p $user_portrait_rel_id]} {
+ if {$user_portrait_rel_id eq ""} {
db_exec_plsql create_rel {}
}
}
Index: openacs-4/packages/acs-subsite/www/user/portrait/upload.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/user/portrait/upload.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-subsite/www/user/portrait/upload.tcl 1 Mar 2005 00:01:24 -0000 1.5
+++ openacs-4/packages/acs-subsite/www/user/portrait/upload.tcl 10 Jan 2007 21:22:11 -0000 1.6
@@ -15,7 +15,7 @@
set current_user_id [ad_conn user_id]
-if [empty_string_p $user_id] {
+if {$user_id eq ""} {
subsite::upload_allowed
set user_id $current_user_id
set admin_p 0
@@ -25,10 +25,10 @@
ad_require_permission $user_id "write"
-if ![db_0or1row name "select
+if {![db_0or1row name "select
first_names, last_name
from persons
-where person_id=:user_id"] {
+where person_id=:user_id"]} {
ad_return_error "Account Unavailable" "We can't find you (user #$user_id) in the users table. Probably your account was deleted for some reason."
return
}
Index: openacs-4/packages/acs-tcl/lib/actions.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/lib/actions.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-tcl/lib/actions.tcl 20 Mar 2005 00:47:07 -0000 1.1
+++ openacs-4/packages/acs-tcl/lib/actions.tcl 10 Jan 2007 21:22:11 -0000 1.2
@@ -15,11 +15,11 @@
foreach action $action_list {
- if {[string equal [lindex $action 0] "LINK"]} {
+ if {[lindex $action 0] eq "LINK"} {
foreach {type stub text title long} $action {break}
multirow append actions $type "$base_url$stub" $text $title $long
- } elseif {[string equal [lindex $action 0] "SECTION"]} {
+ } elseif {[lindex $action 0] eq "SECTION"} {
foreach {type title long} $action {break}
multirow append actions $type {} {} $title $long
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 -r1.5 -r1.6
--- openacs-4/packages/acs-tcl/lib/page-error.tcl 4 Jun 2006 00:45:47 -0000 1.5
+++ openacs-4/packages/acs-tcl/lib/page-error.tcl 10 Jan 2007 21:22:11 -0000 1.6
@@ -61,7 +61,7 @@
set bt_instance [parameter::get -package_id [ad_acs_kernel_id] \
-parameter BugTrackerInstance -default ""]
-if { ![empty_string_p $bt_instance] } {
+if { $bt_instance ne "" } {
array set community_info [site_node::get -url "${bt_instance}/[bug_tracker::package_key]"]
set bt_package_id $community_info(package_id)
set auto_submit_p [parameter::get -parameter AutoSubmitErrorsP -package_id $bt_package_id -default 0]
@@ -79,7 +79,7 @@
set enabled_action_id [form get_action bug_edit]
set exist_bug [db_string search_bug {} -default ""]
- if { [empty_string_p $exist_bug]} {
+ if { $exist_bug eq ""} {
#Submit the new Bug into the Bug - Tracker && Into the
# Auto_bugs tabble
@@ -111,7 +111,7 @@
array set row [list]
set bug_id $exist_bug
- if {[empty_string_p $bug_number]} {
+ if {$bug_number eq ""} {
db_dml increase_reported_times { *SQL* }
}
@@ -124,7 +124,7 @@
foreach available_enabled_action_id [workflow::case::get_available_enabled_action_ids -case_id $case_id] {
workflow::case::enabled_action_get -enabled_action_id $available_enabled_action_id -array enabled_action
workflow::action::get -action_id $enabled_action(action_id) -array available_action
- if [string match "*Reopen*" $available_action(pretty_name)] {
+ if {[string match "*Reopen*" $available_action(pretty_name)]} {
bug_tracker::bug::edit \
-bug_id $bug_id \
-enabled_action_id $available_enabled_action_id \
@@ -133,7 +133,7 @@
-array row \
-entry_id $bug(entry_id)
}
- if [string match "*Comment*" $available_action(pretty_name)] {
+ if {[string match "*Comment*" $available_action(pretty_name)]} {
set comment_action $available_enabled_action_id
}
}
@@ -156,7 +156,7 @@
# Registration required for all actions
set action_id ""
- #if { ![empty_string_p $enabled_action_id] } {
+ #if { $enabled_action_id ne "" } {
# workflow::case::enabled_action_get -enabled_action_id $enabled_action_id -array enabled_action
# set action_id $enabled_action(action_id)
# }
@@ -256,7 +256,7 @@
array set row [list]
-# if { ![empty_string_p $enabled_action_id] } {
+# if { $enabled_action_id ne "" } {
# foreach field [workflow::action::get_element -action_id $action_id -element edit_fields] {
# set row($field) [element get_value bug_edit $field]
# }
@@ -284,7 +284,7 @@
foreach available_enabled_action_id [workflow::case::get_available_enabled_action_ids -case_id $case_id] {
workflow::case::enabled_action_get -enabled_action_id $available_enabled_action_id -array enabled_action
workflow::action::get -action_id $enabled_action(action_id) -array available_action
- if [string match "*Comment*" $available_action(pretty_name)] {
+ if {[string match "*Comment*" $available_action(pretty_name)]} {
set comment_action $available_enabled_action_id
}
}
@@ -322,7 +322,7 @@
foreach {category_id category_name} [bug_tracker::category_types] {
lappend element_names $category_id
set bug($category_id) [cr::keyword::item_get_assigned -item_id $bug(bug_id) -parent_id $category_id]
- if {[string compare $bug($category_id) ""] == 0} {
+ if {$bug($category_id) eq "" } {
set bug($category_id) [bug_tracker::get_default_keyword -parent_id $category_id]
}
}
@@ -362,7 +362,7 @@
# check that the element exists
if { [info exists bug_edit:$element] && [info exists bug($element)] } {
if {[form is_request bug_edit]
- || [string equal [element get_property bug_edit $element mode] display] } {
+ || [string equal [element get_property bug_edit $element mode] "display"] } {
if { [string first "\#" $bug($element)] == 0 } {
element set_value bug_edit $element [lang::util::localize $bug($element)]
} else {
@@ -372,7 +372,7 @@
}
}
# Add empty option to resolution code
- if { ![empty_string_p $enabled_action_id] } {
+ if { $enabled_action_id ne "" } {
if { [lsearch [workflow::action::get_element -action_id $action_id -element edit_fields] "resolution"] == -1 } {
element set_properties bug_edit resolution -options [concat {{{} {}}} [element get_property bug_edit resolution options]]
}
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.64 -r1.65
--- openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl 15 Dec 2006 00:02:00 -0000 1.64
+++ openacs-4/packages/acs-tcl/tcl/00-database-procs.tcl 10 Jan 2007 21:22:11 -0000 1.65
@@ -153,7 +153,7 @@
@author Andrew Piskorski (atp@piskorski.com)
@creation-date 2003/03/16
} {
- if { [empty_string_p $dbn] } {
+ if { $dbn eq "" } {
set dbn [nsv_get {db_default_database} .]
}
return "db_state_${dbn}"
@@ -207,7 +207,7 @@
# These are the default driverkey values, if they are not set
# in the config file:
- if { [string match Oracle* $driver] } {
+ if { [string match "Oracle*" $driver] } {
set driverkey {oracle}
} elseif { [string equal $driver {PostgreSQL}] } {
set driverkey {postgresql}
@@ -237,7 +237,7 @@
ad_proc -public db_compatible_rdbms_p { db_type } {
@return 1 if the given db_type is compatible with the current RDBMS.
} {
- return [expr { [empty_string_p $db_type] || [string equal [db_type] $db_type] }]
+ return [expr { $db_type eq "" || [db_type] eq $db_type }]
}
ad_proc -deprecated db_package_supports_rdbms_p { db_type_list } {
@@ -252,7 +252,7 @@
# DRB: Legacy package check - we allow installation of old aD Oracle 4.2 packages,
# though we don't guarantee that they work.
- if { [db_type] == "oracle" && [lsearch $db_type_list "oracle-8.1.6"] != -1 } {
+ if { [db_type] eq "oracle" && [lsearch $db_type_list "oracle-8.1.6"] != -1 } {
return 1
}
@@ -316,7 +316,7 @@
ad_proc -public db_nullify_empty_string { string } {
A convenience function that returns [db_null] if $string is the empty string.
} {
- if { [empty_string_p $string] } {
+ if { $string eq "" } {
return [db_null]
} else {
return $string
@@ -709,7 +709,7 @@
set function_name "__exec_${unique_id}_${fname}"
# insert tcl variable values (Openacs - Dan)
- if {![string equal $sql $pre_sql]} {
+ if {$sql ne $pre_sql } {
set sql [uplevel 2 [list subst -nobackslashes $sql]]
}
ns_log Debug "PLPGSQL: converted: $sql to: select $function_name ()"
@@ -787,8 +787,8 @@
set all_indices [regexp -inline -indices -all -- {(?:^|[^'])(')(?:[^']|'')+(')(?=$|[^'])} $sql]
for {set i 0} { $i < [llength $all_indices] } { incr i 3 } {
- lappend quote_indices [lindex [lindex $all_indices [expr $i + 1]] 0]
- lappend quote_indices [lindex [lindex $all_indices [expr $i + 2]] 0]
+ lappend quote_indices [lindex [lindex $all_indices [expr {$i + 1}]] 0]
+ lappend quote_indices [lindex [lindex $all_indices [expr {$i + 2}]] 0]
}
return $quote_indices
@@ -798,7 +798,7 @@
} {
foreach {quote_start_idx quote_end_idx} [db_get_quote_indices $sql] {
- if { [expr $bind_start_idx > $quote_start_idx] && [expr $bind_end_idx < $quote_end_idx]} {
+ if { [expr {$bind_start_idx > $quote_start_idx}] && [expr {$bind_end_idx < $quote_end_idx}]} {
return 1
}
}
@@ -814,19 +814,19 @@
function.
} {
- if {[string equal $bind ""]} {
+ if {$bind eq ""} {
upvar __db_sql lsql
set lsql $sql
uplevel {
set __db_lst [regexp -inline -indices -all -- {:?:\w+} $__db_sql]
- for {set __db_i [expr [llength $__db_lst] - 1]} {$__db_i >= 0} {incr __db_i -1} {
+ for {set __db_i [expr {[llength $__db_lst] - 1}]} {$__db_i >= 0} {incr __db_i -1} {
set __db_ws [lindex [lindex $__db_lst $__db_i] 0]
set __db_we [lindex [lindex $__db_lst $__db_i] 1]
set __db_bind_var [string range $__db_sql $__db_ws $__db_we]
if {![string match "::*" $__db_bind_var] && ![db_bind_var_quoted_p $__db_sql $__db_ws $__db_we]} {
set __db_tcl_var [string range $__db_bind_var 1 end]
set __db_tcl_var [set $__db_tcl_var]
- if {[string equal $__db_tcl_var ""]} {
+ if {$__db_tcl_var eq ""} {
set __db_tcl_var null
} else {
set __db_tcl_var "'[DoubleApos $__db_tcl_var]'"
@@ -841,14 +841,14 @@
set lsql $sql
set lst [regexp -inline -indices -all -- {:?:\w+} $sql]
- for {set i [expr [llength $lst] - 1]} {$i >= 0} {incr i -1} {
+ for {set i [expr {[llength $lst] - 1}]} {$i >= 0} {incr i -1} {
set ws [lindex [lindex $lst $i] 0]
set we [lindex [lindex $lst $i] 1]
set bind_var [string range $sql $ws $we]
if {![string match "::*" $bind_var] && ![db_bind_var_quoted_p $lsql $ws $we]} {
set tcl_var [string range $bind_var 1 end]
set val $bind_vars($tcl_var)
- if {[string equal $val ""]} {
+ if {$val eq ""} {
set val null
} else {
set val "'[DoubleApos $val]'"
@@ -932,7 +932,7 @@
set sql [db_qd_replace_sql $statement_name $pre_sql]
# insert tcl variable values (Openacs - Dan)
- if {![string equal $sql $pre_sql]} {
+ if {$sql ne $pre_sql } {
set sql [uplevel $ulevel [list subst -nobackslashes $sql]]
}
@@ -1014,10 +1014,10 @@
# JCD: we log the clicks, dbname, query time, and statement to catch long running queries.
# If we took more than 5 seconds yack about it.
- if { [expr [clock clicks -milliseconds] - $start_time] > 5000} {
- ns_log Warning "db_exec: longdb [expr [clock seconds] - $start_time_fine] seconds $db $type $statement_name"
+ if { [expr {[clock clicks -milliseconds] - $start_time}] > 5000} {
+ ns_log Warning "db_exec: longdb [expr {[clock seconds] - $start_time_fine}] seconds $db $type $statement_name"
} else {
- ns_log Debug "db_exec: timing [expr [clock seconds] - $start_time_fine] seconds $db $type $statement_name"
+ ns_log Debug "db_exec: timing [expr {[clock seconds] - $start_time_fine}] seconds $db $type $statement_name"
}
ds_collect_db_call $db $type $statement_name $sql $start_time $errno $error
@@ -1273,7 +1273,7 @@
set code_block [lindex $args 0]
} elseif { $arglength == 3 } {
# Should have code block + if_no_rows + code block.
- if { ![string equal [lindex $args 1] "if_no_rows"] && ![string equal [lindex $args 1] "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]
@@ -1400,7 +1400,7 @@
}
# Save values of columns which we might clobber
- if { $unclobber_p && ![empty_string_p $code_block] } {
+ if { $unclobber_p && $code_block ne "" } {
foreach col $columns {
upvar 1 $col column_value __saved_$col column_save
@@ -1418,7 +1418,7 @@
}
}
- if { [empty_string_p $code_block] } {
+ if { $code_block eq "" } {
# No code block - pull values directly into the var_name array.
# The extra loop after the last row is only for when there's a code block
@@ -1440,7 +1440,7 @@
unset this_row
}
set array_get_next_row [array get next_row]
- if { ![empty_string_p $array_get_next_row] } {
+ if { $array_get_next_row ne "" } {
array set this_row [array get next_row]
}
@@ -1516,7 +1516,7 @@
}
# Restore values of columns which we've saved
- if { $unclobber_p && ![empty_string_p $code_block] && $local_counter > 0 } {
+ if { $unclobber_p && $code_block ne "" && $local_counter > 0 } {
foreach col $columns {
upvar 1 $col column_value __saved_$col column_save
@@ -1679,8 +1679,8 @@
set code_block [lindex $args 0]
} elseif { $arglength == 3 } {
# Should have code block + if_no_rows + code block.
- if { ![string equal [lindex $args 1] "if_no_rows"] \
- && ![string equal [lindex $args 1] "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]
@@ -1794,7 +1794,7 @@
}
upvar 1 $column column_value
# Otherwise, it's the last row in the group if the next row has a different value than this row
- return [expr ![string equal $column_value $next_row($column)]]
+ return [expr {$column_value ne $next_row($column) }]
}
@@ -1875,7 +1875,7 @@
}
}
- } elseif { [string equal $command "blob_dml_file"] } {
+ } elseif {$command eq "blob_dml_file"} {
# PostgreSQL:
db_with_handle -dbn $dbn db {
# another ugly hack to avoid munging tcl files.
@@ -2108,7 +2108,7 @@
error $syn_err
} elseif { $arg_c == 2 } {
# We think they're specifying an on_error block
- if { [string compare [lindex $args 0] "on_error"] } {
+ if {[lindex $args 0] ne "on_error" } {
# Unexpected: they put something besides on_error as a connector.
error $syn_err
} else {
@@ -2164,9 +2164,9 @@
if { $err_p || [db_abort_transaction_p -dbn $dbn]} {
# An error was triggered or the transaction has been aborted.
db_abort_transaction -dbn $dbn
- if { [info exists on_error] && ![empty_string_p $on_error] } {
+ if { [info exists on_error] && $on_error ne "" } {
- if {[string equal postgresql [db_type]]} {
+ if {"postgresql" eq [db_type]} {
# JCD: with postgres we abort the transaction prior to
# executing the on_error block since there is nothing
@@ -2366,7 +2366,7 @@
} {
set pool [lindex [db_available_pools $dbn] 0]
set datasource [ns_config "ns/db/pool/$pool" DataSource]
- if { ![empty_string_p $datasource] && ![string is space $datasource] } {
+ if { $datasource ne "" && ![string is space $datasource] } {
return "[ns_config ns/db/pool/$pool User]/[ns_config ns/db/pool/$pool Password]@$datasource"
} else {
return "[ns_config ns/db/pool/$pool User]/[ns_config ns/db/pool/$pool Password]"
@@ -2407,12 +2407,12 @@
}
set first_colon_pos [string first ":" $datasource]
- if { $first_colon_pos == $last_colon_pos || [expr $last_colon_pos - $first_colon_pos] == 1 } {
+ if { $first_colon_pos == $last_colon_pos || [expr {$last_colon_pos - $first_colon_pos}] == 1 } {
# No port specified
return ""
}
- return [string range $datasource [expr $first_colon_pos + 1] [expr $last_colon_pos - 1] ]
+ return [string range $datasource [expr {$first_colon_pos + 1}] [expr {$last_colon_pos - 1}] ]
}
@@ -2433,7 +2433,7 @@
ns_log Error "datasource contains no \":\"? datasource = $datasource"
return ""
}
- return [string range $datasource [expr $last_colon_pos + 1] end]
+ return [string range $datasource [expr {$last_colon_pos + 1}] end]
}
@@ -2454,7 +2454,7 @@
ns_log Error "datasource contains no \":\"? datasource = $datasource"
return ""
}
- return [string range $datasource 0 [expr $first_colon_pos - 1]]
+ return [string range $datasource 0 [expr {$first_colon_pos - 1}]]
}
ad_proc -public db_source_sql_file {{
@@ -2491,17 +2491,17 @@
set file_name [file tail $file]
set pguser [db_get_username]
- if { ![string equal $pguser ""] } {
+ if { $pguser ne "" } {
set pguser "-U $pguser"
}
set pgport [db_get_port]
- if { ![string equal $pgport ""] } {
+ if { $pgport ne "" } {
set pgport "-p $pgport"
}
set pgpass [db_get_password]
- if { ![string equal $pgpass ""] } {
+ if { $pgpass ne "" } {
set pgpass "<<$pgpass"
}
@@ -2519,7 +2519,7 @@
cd [file dirname $file]
ns_log notice "\n DAVEB pghost = '${pghost}' pgport = '${pgport}' pguser = '${pguser}' \n"
- if { $tcl_platform(platform) == "windows" } {
+ if { $tcl_platform(platform) eq "windows" } {
set fp [open "|[file join [db_get_pgbin] psql] $pghost $pgport $pguser -f $file_name [db_get_database] $pgpass" "r"]
} else {
set fp [open "|[file join [db_get_pgbin] psql] $pghost $pgport $pguser -f $file_name [db_get_database] $pgpass" "r"]
@@ -2626,17 +2626,17 @@
global tcl_platform
set pguser [db_get_username]
- if { ![string equal $pguser ""] } {
+ if { $pguser ne "" } {
set pguser "-U $pguser"
}
set pgport [db_get_port]
- if { ![string equal $pgport ""] } {
+ if { $pgport ne "" } {
set pgport "-p $pgport"
}
set pgpass [db_get_password]
- if { ![string equal $pgpass ""] } {
+ if { $pgpass ne "" } {
set pgpass "<<$pgpass"
}
@@ -2654,7 +2654,7 @@
puts $fd $copy_command
close $fd
- if { $tcl_platform(platform) == "windows" } {
+ if { $tcl_platform(platform) eq "windows" } {
set fp [open "|[file join [db_get_pgbin] psql] -f $copy_file $pghost $pgport $pguser [db_get_database]" "r"]
} else {
set fp [open "|[file join [db_get_pgbin] psql] -f $copy_file $pghost $pgport $pguser [db_get_database] $pgpass" "r"]
@@ -2935,7 +2935,7 @@
if { $column_type == -1 } {
return "Either table $table_name doesn't exist or column $column_name doesn't exist"
- } elseif { [string compare $column_type "NUMBER"] } {
+ } elseif {$column_type ne "NUMBER" } {
return "numeric"
} else {
return "text"
@@ -3053,7 +3053,7 @@
set sql [db_qd_replace_sql $full_statement_name $pre_sql]
# insert tcl variable values (borrowed from Dan W - olah)
- if {![string equal $sql $pre_sql]} {
+ if {$sql ne $pre_sql } {
set sql [uplevel 2 [list subst -nobackslashes $sql]]
}
@@ -3126,14 +3126,14 @@
set sql [db_qd_replace_sql $statement_name $pre_sql]
# insert tcl variable values (Openacs - Dan)
- if {![string equal $sql $pre_sql]} {
+ if {$sql ne $pre_sql } {
set sql [uplevel $ulevel [list subst -nobackslashes $sql]]
}
set file_storage_p 0
upvar $ulevel storage_type storage_type
- if {[info exists storage_type] && [string equal $storage_type file]} {
+ if {[info exists storage_type] && $storage_type eq "file"} {
set file_storage_p 1
set original_type $type
set qtype 1row
@@ -3154,7 +3154,7 @@
if { [info exists bind] && [llength $bind] != 0 } {
if { [llength $bind] == 1 } {
- if { [empty_string_p $file] } {
+ if { $file eq "" } {
set selection [eval [list ns_ora $qtype $db -bind $bind $sql]]
} else {
set selection [eval [list ns_ora $qtype $db -bind $bind $sql $file]]
@@ -3165,15 +3165,15 @@
foreach { name value } $bind {
ns_set put $bind_vars $name $value
}
- if { [empty_string_p $file] } {
+ if { $file eq "" } {
set selection [eval [list ns_ora $qtype $db -bind $bind_vars $sql]]
} else {
set selection [eval [list ns_ora $qtype $db -bind $bind_vars $sql $file]]
}
}
} else {
- if { [empty_string_p $file] } {
+ if { $file eq "" } {
set selection [uplevel $ulevel [list ns_ora $qtype $db $sql]]
} else {
set selection [uplevel $ulevel [list ns_ora $qtype $db $sql $file]]
@@ -3184,7 +3184,7 @@
set content [ns_set value $selection 0]
for {set i 0} {$i < [ns_set size $selection]} {incr i} {
set name [ns_set key $selection $i]
- if {[string equal $name content]} {
+ if {$name eq "content"} {
set content [ns_set value $selection $i]
}
}
@@ -3246,7 +3246,7 @@
set sql [db_qd_replace_sql $statement_name $pre_sql]
# insert tcl variable values (Openacs - Dan)
- if {![string equal $sql $pre_sql]} {
+ if {$sql ne $pre_sql } {
set sql [uplevel $ulevel [list subst -nobackslashes $sql]]
}
# create a function definition statement for the inline code
@@ -3278,9 +3278,9 @@
set content [ns_set value $selection 0]
for {set i 0} {$i < [ns_set size $selection]} {incr i} {
set name [ns_set key $selection $i]
- if {[string equal $name storage_type]} {
+ if {$name eq "storage_type"} {
set storage_type [ns_set value $selection $i]
- } elseif {[string equal $name content]} {
+ } elseif {$name eq "content"} {
set content [ns_set value $selection $i]
}
}
Index: openacs-4/packages/acs-tcl/tcl/30-xml-utils-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/30-xml-utils-procs.tcl,v
diff -u -r1.10 -r1.11
--- openacs-4/packages/acs-tcl/tcl/30-xml-utils-procs.tcl 22 Aug 2005 16:02:45 -0000 1.10
+++ openacs-4/packages/acs-tcl/tcl/30-xml-utils-procs.tcl 10 Jan 2007 21:22:11 -0000 1.11
@@ -23,7 +23,7 @@
# Parse a document and return a doc_id
proc xml_parse args {
# ns_log notice "xml_parse $args"
- if {[lindex $args 0] == "-persist"} {
+ if {[lindex $args 0] eq "-persist"} {
return [dom parse -simple [lindex $args 1]]
} else {
dom parse -simple [lindex $args 0] doc
Index: openacs-4/packages/acs-tcl/tcl/acs-permissions-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/acs-permissions-procs.tcl,v
diff -u -r1.28 -r1.29
--- openacs-4/packages/acs-tcl/tcl/acs-permissions-procs.tcl 4 Mar 2005 22:30:50 -0000 1.28
+++ openacs-4/packages/acs-tcl/tcl/acs-permissions-procs.tcl 10 Jan 2007 21:22:11 -0000 1.29
@@ -70,7 +70,7 @@
@param privilege The privilege you want to check for.
} {
- if { [empty_string_p $party_id] } {
+ if { $party_id eq "" } {
set party_id [ad_conn user_id]
}
@@ -124,7 +124,7 @@
@see permission::permission_p
} {
- if { [empty_string_p $party_id] } {
+ if { $party_id eq "" } {
set party_id [ad_conn user_id]
}
@@ -151,7 +151,7 @@
} {
require that party X have privilege Y on object Z
} {
- if {[empty_string_p $party_id]} {
+ if {$party_id eq ""} {
set party_id [ad_conn user_id]
}
@@ -229,7 +229,7 @@
if { [permission::permission_p -privilege write -object_id $object_id -party_id $party_id] } {
return 1
}
- if { [empty_string_p $creation_user] } {
+ if { $creation_user eq "" } {
set creation_user [acs_object::get_element -object_id $object_id -element creation_user]
}
if { [ad_conn user_id] == $creation_user } {
Index: openacs-4/packages/acs-tcl/tcl/ad-functional-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/ad-functional-procs.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-tcl/tcl/ad-functional-procs.tcl 27 Feb 2005 22:45:39 -0000 1.5
+++ openacs-4/packages/acs-tcl/tcl/ad-functional-procs.tcl 10 Jan 2007 21:22:11 -0000 1.6
@@ -468,23 +468,23 @@
}
ad_proc -public last {xs} "last element of a list" {
- lindex $xs [expr [llength $xs]-1]
+ lindex $xs [expr {[llength $xs]-1}]
}
ad_proc -public init {xs} "all elements of a list but the last" {
- lrange $xs 0 [expr [llength $xs]-2]
+ lrange $xs 0 [expr {[llength $xs]-2}]
}
ad_proc -public tail {xs} "all elements of a list but the first" {
- lrange $xs 1 [expr [llength $xs]-1]
+ lrange $xs 1 [expr {[llength $xs]-1}]
}
ad_proc -public take {n xs} "returns the first n elements of xs" {
lrange $xs 0 [expr {$n-1}]
}
ad_proc -public drop {n xs} "returns the remaining elements of xs (without the first n)" {
- lrange $xs $n [expr [llength $xs]-1]
+ lrange $xs $n [expr {[llength $xs]-1}]
}
ad_proc -public filter {pred xs} {
@@ -602,15 +602,15 @@
ad_proc -public transpose {lists} "tranposes a matrix (a list of lists)" {
set num_lists [llength $lists]
- if !$num_lists { return "" }
+ if {!$num_lists} { return "" }
for {set i 0} {$i<$num_lists} {incr i} {
set l($i) [lindex $lists $i]
}
set result {}
while {1} {
set element {}
for {set i 0} {$i<$num_lists} {incr i} {
- if [null_p $l($i)] { return $result }
+ if {[null_p $l($i)]} { return $result }
lappend element [head $l($i)]
set l($i) [tail $l($i)]
}
Index: openacs-4/packages/acs-tcl/tcl/admin-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/admin-procs.tcl,v
diff -u -r1.17 -r1.18
--- openacs-4/packages/acs-tcl/tcl/admin-procs.tcl 26 Feb 2005 17:52:20 -0000 1.17
+++ openacs-4/packages/acs-tcl/tcl/admin-procs.tcl 10 Jan 2007 21:22:11 -0000 1.18
@@ -160,7 +160,7 @@
}
}
- if { [info exists combine_method] && $combine_method == "or" } {
+ if { [info exists combine_method] && $combine_method eq "or" } {
set pretty_description [join $clauses " or "]
} else {
set pretty_description [join $clauses " and "]
@@ -191,7 +191,7 @@
# Get all the non-LOB columns.
set user_columns [list]
foreach column [db_columns users] {
- if { $column != "portrait" && $column != "portrait_thumbnail" } {
+ if { $column ne "portrait" && $column ne "portrait_thumbnail" } {
lappend user_columns "users.$column"
}
}
@@ -209,7 +209,7 @@
lappend select_list "user_demographics_summary(users.user_id) as demographics_summary"
}
- if { [info exists user_class_id] && ![empty_string_p $user_class_id] } {
+ if { [info exists user_class_id] && $user_class_id ne "" } {
set sql_post_select [db_string sql_post_select_for_user_class "
select sql_post_select
from user_classes where user_class_id = [ns_dbquotevalue $user_class_id]
@@ -218,7 +218,7 @@
return "select [join $select_list ",\n "]\n$sql_post_select"
}
- if { [info exists sql_post_select] && ![empty_string_p $sql_post_select] } {
+ if { [info exists sql_post_select] && $sql_post_select ne "" } {
return "select [join $select_list ",\n "]\n$sql_post_select"
}
@@ -249,7 +249,7 @@
}
"intranet_user_p" {
- if {$intranet_user_p == "t" && [lsearch $tables "intranet_users"] == -1 } {
+ if {$intranet_user_p eq "t" && [lsearch $tables "intranet_users"] == -1 } {
lappend tables "intranet_users"
lappend join_clauses "users.user_id = intranet_users.user_id"
}
@@ -365,7 +365,7 @@
}
#stuff related to the query itself
- if { [info exists combine_method] && $combine_method == "or" } {
+ if { [info exists combine_method] && $combine_method eq "or" } {
set complete_where [join $where_clauses " or "]
} else {
set complete_where [join $where_clauses " and "]
@@ -379,15 +379,15 @@
if { [llength $join_clauses] == 0 } {
set final_query "select [join $select_list ",\n "]
from [join $tables ", "]"
- if { ![empty_string_p $complete_where] } {
+ if { $complete_where ne "" } {
append final_query "\nwhere $complete_where"
}
} else {
# we're joining at
set final_query "select [join $select_list ",\n "]
from [join $tables ", "]
where [join $join_clauses "\nand "]"
- if { ![empty_string_p $complete_where] } {
+ if { $complete_where ne "" } {
append final_query "\n and ($complete_where)"
}
}
@@ -440,7 +440,7 @@
}
}
- if { $email_verified_p == "t" } {
+ if { $email_verified_p eq "t" } {
lappend user_finite_state_links "<a href=\"/acs-admin/users/member-state-change?[export_url_vars user_id return_url]&email_verified_p=f\">[_ acs-tcl.lt_require_email_verific]</a>"
} else {
lappend user_finite_state_links "<a href=\"/acs-admin/users/member-state-change?[export_url_vars user_id return_url]&email_verified_p=t\">[_ acs-tcl.approve_email]</a>"
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 -r1.1 -r1.2
--- openacs-4/packages/acs-tcl/tcl/adp-parser-procs.tcl 13 Mar 2001 22:59:26 -0000 1.1
+++ openacs-4/packages/acs-tcl/tcl/adp-parser-procs.tcl 10 Jan 2007 21:22:11 -0000 1.2
@@ -181,7 +181,7 @@
incr doc_adp_depth -1
global errorCode
- if { $errno == 0 || [string equal $errorCode "doc_adp_abort"] } {
+ if { $errno == 0 || $errorCode eq "doc_adp_abort" } {
return $adp_var
}
@@ -241,7 +241,7 @@
# Currently index points to a "<".
incr index
- if { [string index $adp $index] == "/" } {
+ if { [string index $adp $index] eq "/" } {
set end_tag_p 1
incr index
} elseif { ![info exists literal_tag] && [string index $adp $index] == "%" } {
@@ -286,14 +286,14 @@
if { ![info exists tag] } {
# Find the next non-word character.
set tag_begin $index
- while { [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 [expr { $index - 1 }]]
}
- if { (![info exists literal_tag] || ($end_tag_p && [string equal $tag $literal_tag])) && \
+ if { (![info exists literal_tag] || ($end_tag_p && $tag eq $literal_tag)) && \
[nsv_exists doc_adptags $tag] } {
doc_adp_flush_text_buffer
@@ -338,10 +338,10 @@
while { [string is space -strict [string index $adp $index]] } {
incr index
}
- if { [string index $adp $index] == "\"" } {
+ if { [string index $adp $index] eq "\"" } {
# Quoted string.
set value_begin [incr index]
- while { $index < $adp_length && [string index $adp $index] != "\"" } {
+ while { $index < $adp_length && [string index $adp $index] ne "\"" } {
incr index
}
set value_end $index
@@ -366,7 +366,7 @@
if { [llength $balanced_tag_stack] == 0 } {
return -code error "Unexpected end tag </$tag>"
}
- if { ![string equal $tag [lindex $balanced_tag_stack end]] } {
+ if { $tag ne [lindex $balanced_tag_stack end] } {
return -code error "Expected end tag to be </[lindex $balanced_tag_stack end]>, not </$tag>"
}
set balanced_tag_stack [lrange $balanced_tag_stack 0 [expr { [llength $balanced_tag_stack] - 2 }]]
Index: openacs-4/packages/acs-tcl/tcl/aolserver-3-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/Attic/aolserver-3-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-tcl/tcl/aolserver-3-procs.tcl 28 Aug 2003 09:41:43 -0000 1.3
+++ openacs-4/packages/acs-tcl/tcl/aolserver-3-procs.tcl 10 Jan 2007 21:22:11 -0000 1.4
@@ -16,7 +16,7 @@
upvar $valuebyref value
- if {[ns_set get $formdata $column.NULL] == "t"} {
+ if {[ns_set get $formdata $column.NULL] eq "t"} {
set value ""
return 0
}
@@ -113,12 +113,12 @@
if { ![info exists updatebutton] } {
set updatebutton ""
}
- if { [string match "" $updatebutton] } {
+ if { "" eq $updatebutton } {
db_with_handle db {
set updatebutton [ns_table value $db $table update_button_label]
}
}
- if { [string match "" $updatebutton] } {
+ if { "" eq $updatebutton } {
set updatebutton "Update Record"
}
}
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 -r1.33 -r1.34
--- openacs-4/packages/acs-tcl/tcl/apm-file-procs.tcl 1 Mar 2005 00:01:25 -0000 1.33
+++ openacs-4/packages/acs-tcl/tcl/apm-file-procs.tcl 10 Jan 2007 21:22:12 -0000 1.34
@@ -118,7 +118,7 @@
as a specification file.
} {
- if { [empty_string_p $path] } {
+ if { $path eq "" } {
set path "[acs_package_root_dir $package_key]/$package_key.info"
} else {
set path "$path/$package_key/$package_key.info"
@@ -242,7 +242,7 @@
#Let's check if a current revision exists:
if {![db_0or1row get_revision_id "select live_revision as revision_id
from cr_items
- where item_id = :item_id"] || [empty_string_p $revision_id]} {
+ where item_id = :item_id"] || $revision_id eq ""} {
# It's an insert rather than an update
set revision_id [db_exec_plsql create_revision $create_revision]
}
@@ -314,7 +314,7 @@
@param path The path of the file relative to server root
} {
- if { [string equal $path "packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl"] } {
+ if {$path eq "packages/acs-bootstrap-installer/tcl/30-apm-load-procs.tcl"} {
ns_log Warning "apm_file_watch: Skipping file $path as it cannot be watched. You have to restart the server instead"
}
@@ -332,7 +332,7 @@
@author Peter Marklund
} {
- if { ![empty_string_p $path] } {
+ if { $path ne "" } {
catch { nsv_unset apm_reload_watch $path }
} else {
catch {nsv_unset apm_reload_watch}
@@ -368,18 +368,18 @@
# Check the db type
set file_db_type [apm_guess_db_type $package_key $package_rel_path]
- set right_db_type_p [expr [empty_string_p $file_db_type] || \
+ set right_db_type_p [expr {$file_db_type eq ""} || \
[string equal $file_db_type [db_type]]]
# Check the file type
set file_type [apm_guess_file_type $package_key $package_rel_path]
# 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 {[lsearch -exact $watchable_file_types $file_type] != -1}]
# Both db type and file type must be right
- set watchable_p [expr $right_db_type_p && $right_file_type_p]
+ set watchable_p [expr {$right_db_type_p && $right_file_type_p}]
return $watchable_p
}
@@ -448,7 +448,7 @@
} {
set paths [ad_parameter_all_values_as_list -package_id [ad_acs_kernel_id] SystemCommandPaths acs-kernel]
- if {[empty_string_p $paths]} {
+ if {$paths eq ""} {
return [list "/usr/local/bin" "/usr/bin" "/bin" "/usr/sbin" "/sbin" "/usr/sbin"]
} else {
return $paths
@@ -495,7 +495,7 @@
} {
# First download the apm file if a URL is provided
- if { ![empty_string_p $url] } {
+ if { $url ne "" } {
apm_callback_and_log $callback "<li>Downloading $url..."
if { [catch {
# Open a destination file.
@@ -553,15 +553,15 @@
foreach file $files {
set components [split $file "/"]
- if { [string compare [lindex $components 0] $package_key] } {
+ if {[lindex $components 0] ne $package_key } {
apm_callback_and_log $callback "All files in the archive must be contained in the same directory
(corresponding to the package's key). This is not the case, so the archive is not
a valid APM file.\n"
ns_log Error "Error loading APM file form url $url: Invalid APM file. All files in the archive must be contained in the same directory corresponding to the package's key."
return
}
- if { [llength $components] == 2 && ![string compare [file extension $file] ".info"] } {
+ if { [llength $components] == 2 && [file extension $file] eq ".info" } {
if { [info exists info_file] } {
apm_callback_and_log $callback "The archive contains more than one <tt>package/*/*.info</tt> file, so it is not a valid APM file.</ul>\n"
ns_log Error "Error loading APM file form url $url: Invalid APM file. More than one package .info file."
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 -r1.86 -r1.87
--- openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 4 Jun 2006 00:45:47 -0000 1.86
+++ openacs-4/packages/acs-tcl/tcl/apm-install-procs.tcl 10 Jan 2007 21:22:12 -0000 1.87
@@ -23,7 +23,7 @@
@return A list of unregistered .info files that can be parsed for further information.
} {
- if { [empty_string_p $path] } {
+ if { $path eq "" } {
set path "[apm_workspace_install_dir]"
}
@@ -99,10 +99,10 @@
return 1
}
- if { ![empty_string_p $dependency_list] } {
+ if { $dependency_list ne "" } {
# They provided a list of provisions.
foreach prov $dependency_list {
- if { [string equal $dependency_uri [lindex $prov 0]] } {
+ if {$dependency_uri eq [lindex $prov 0]} {
set provided_version [lindex $prov 1]
set provided_p [db_string version_greater_p {}]
@@ -658,7 +658,7 @@
# Determine if we are upgrading or installing.
set upgrade_from_version_name [apm_package_upgrade_from $package_key $version(name)]
- set upgrade_p [expr ![empty_string_p $upgrade_from_version_name]]
+ set upgrade_p [expr {$upgrade_from_version_name ne ""}]
if { [string match "[apm_workspace_install_dir]*" $package_path] } {
# Package is being installed from the apm_workspace dir (expanded from .apm file)
@@ -713,7 +713,7 @@
# to invoke any Tcl callbacks after mounting and instantiation. Note that this reloading
# is only done in the Tcl interpreter of this particular request.
# Note that acs-tcl is a special case as its procs are always sourced on startup from boostrap.tcl
- if { ![string equal $package_key "acs-tcl"] } {
+ if { $package_key ne "acs-tcl" } {
apm_load_libraries -procs -force_reload -packages $package_key
apm_load_queries -packages $package_key
}
@@ -819,7 +819,7 @@
apm_invoke_callback_proc -version_id $version_id -type after-install
set priority_mount_path [ad_decode $version(auto-mount) "" $mount_path $version(auto-mount)]
- if { ![empty_string_p $priority_mount_path] } {
+ if { $priority_mount_path ne "" } {
# This is a package that should be auto mounted
set parent_id [site_node::get_node_id -url "/"]
@@ -831,7 +831,7 @@
} error] } {
# There is already a node with that path, check if there is a package mounted there
array set node [site_node::get -url "/${priority_mount_path}"]
- if { [empty_string_p $node(object_id)] } {
+ if { $node(object_id) eq "" } {
# There is no package mounted there so go ahead and mount the new package
set node_id $node(node_id)
} else {
@@ -840,7 +840,7 @@
}
}
- if { ![empty_string_p $node_id] } {
+ if { $node_id ne "" } {
site_node::instantiate_and_mount \
-node_id $node_id \
@@ -857,7 +857,7 @@
apm_callback_and_log $callback "<p> $error_text </p>"
}
- } elseif { [string equal $package_type "apm_service"] && [string equal $singleton_p "t"] } {
+ } elseif { $package_type eq "apm_service" && $singleton_p eq "t" } {
# This is a singleton package. Instantiate it automatically, but don't mount.
# Using empty context_id
@@ -889,10 +889,10 @@
} {
upvar $array local_array
- if { [empty_string_p $version_id] } {
+ if { $version_id eq "" } {
set version_id [db_null]
}
- if { [empty_string_p $release_date] } {
+ if { $release_date eq "" } {
set release_date [db_null]
}
@@ -1012,7 +1012,7 @@
}
# Source SQL drop scripts
- if {![empty_string_p $sql_drop_scripts]} {
+ if {$sql_drop_scripts ne ""} {
apm_callback_and_log $callback "Now executing drop scripts.
<ul>
@@ -1077,7 +1077,7 @@
set package_key $version(package.key)
set upgrade_to_version_name $version(name)
- if { [empty_string_p $path] } {
+ if { $path eq "" } {
set path "[acs_package_root_dir $package_key]"
}
set ul_p 0
@@ -1090,16 +1090,16 @@
$package_key]
}
- if { ![empty_string_p $data_model_files] } {
+ if { $data_model_files ne "" } {
apm_callback_and_log $callback "<p><li>Installing data model for $version(package-name) $version(name)...\n"
}
foreach item $data_model_files {
set file_path [lindex $item 0]
set file_type [lindex $item 1]
ns_log Debug "apm_package_install_data_model: Now processing $file_path of type $file_type"
- if {![string compare $file_type "data_model_create"] || \
- ![string compare $file_type "data_model_upgrade"] } {
+ if {$file_type eq "data_model_create" || \
+ $file_type eq "data_model_upgrade" } {
if { !$ul_p } {
apm_callback_and_log $callback "<ul>\n"
set ul_p 1
@@ -1109,7 +1109,7 @@
"
db_source_sql_file -callback $callback $path/$file_path
apm_callback_and_log $callback "</pre></blockquote>\n"
- } elseif { ![string compare $file_type "sqlj_code"] } {
+ } elseif { $file_type eq "sqlj_code" } {
if { !$ul_p } {
apm_callback_and_log $callback "<ul>\n"
set ul_p 1
@@ -1119,7 +1119,7 @@
"
db_source_sqlj_file -callback $callback "$path/$file_path"
apm_callback_and_log $callback "</pre></blockquote>\n"
- } elseif { [string equal $file_type "ctl_file"] } {
+ } elseif {$file_type eq "ctl_file"} {
ns_log Debug "apm_package_install_data_model: Now processing $file_path of type ctl_file"
if { !$ul_p } {
apm_callback_and_log $callback "<ul>\n"
@@ -1385,17 +1385,17 @@
Register the package in the system.
} {
- if { [empty_string_p $spec_file_path] } {
+ if { $spec_file_path eq "" } {
set spec_file_path [db_null]
}
- if { [empty_string_p $spec_file_mtime] } {
+ if { $spec_file_mtime eq "" } {
set spec_file_mtime [db_null]
}
- if { ![string compare $package_type "apm_application"] } {
+ if { $package_type eq "apm_application" } {
db_exec_plsql application_register {}
- } elseif { ![string compare $package_type "apm_service"] } {
+ } elseif { $package_type eq "apm_service" } {
db_exec_plsql service_register {}
} else {
error "Unrecognized package type: $package_type"
@@ -1412,7 +1412,7 @@
} {
upvar $array local_array
- if { [empty_string_p $release_date] } {
+ if { $release_date eq "" } {
set release_date [db_null]
}
@@ -1557,7 +1557,7 @@
@file_list A list of files and file types of form [list [list "foo.sql" "data_model_upgrade"] ...]
} {
set types_to_retrieve [list "sqlj_code"]
- if {[empty_string_p $upgrade_from_version_name]} {
+ if {$upgrade_from_version_name eq ""} {
lappend types_to_retrieve "data_model_create"
# Assuming here that ctl_file files are not upgrade scripts
# TODO: Make it possible to determine which ctl files are upgrade scripts and which aren't
@@ -1577,15 +1577,15 @@
if {[lsearch -exact $types_to_retrieve $file_type] != -1 } {
set list_item [list $path $file_type $package_key]
- if { [string equal $file_type "data_model_upgrade"] } {
+ if {$file_type eq "data_model_upgrade"} {
# Upgrade script
if {[apm_upgrade_for_version_p $path $upgrade_from_version_name \
$upgrade_to_version_name]} {
# Its a valid upgrade script.
ns_log Debug "apm_data_model_scripts_find: Adding $path to the list of upgrade files."
lappend upgrade_file_list $list_item
}
- } elseif { [string equal $file_type "ctl_file"] } {
+ } elseif {$file_type eq "ctl_file"} {
lappend ctl_file_list $list_item
} else {
# Install script
@@ -1623,7 +1623,7 @@
# supported databases.
if {[lsearch -exact "query_file" $file_type] != -1 && \
- ([empty_string_p $file_db_type] || ![string compare [db_type] $file_db_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
}
@@ -1812,7 +1812,7 @@
@author Lars Pind
} {
- if { [expr [llength $spec] % 3] != 0 } {
+ if { [expr {[llength $spec] % 3}] != 0 } {
error "The length of spec should be dividable by 3"
}
@@ -1863,17 +1863,17 @@
apm_get_installed_versions -array installed_version
- if { ![empty_string_p $repository_url] } {
+ if { $repository_url ne "" } {
set manifest_url "${repository_url}manifest.xml"
# See if we already have it in a client property
set manifest [ad_get_client_property acs-admin [string range $manifest_url end-49 end]]
- if { [empty_string_p $manifest] } {
+ if { $manifest eq "" } {
# Nope, get it now
array set result [ad_httpget -url $manifest_url]
- if { ![string equal $result(status) 200] } {
+ if { $result(status) ne "200" } {
error "Couldn't get the package list. Please try again later."
}
@@ -1924,7 +1924,7 @@
ns_log Debug "apm_get_package_repository: $version(package.key) = $version(install_type) -- [array get installed_version]"
- if { ![string equal $version(install_type) already_installed] } {
+ if { $version(install_type) ne "already_installed" } {
set repository($version(package.key)) [array get version]
}
}
@@ -1950,7 +1950,7 @@
set version(install_type) upgrade
}
- if { ![string equal $version(install_type) already_installed] } {
+ if { $version(install_type) ne "already_installed" } {
set repository($version(package.key)) [array get version]
}
}
@@ -1997,7 +1997,7 @@
set __the_body__ [read $file]
close $file
# Interpolate the vars.
- if {![empty_string_p $binds]} {
+ if {$binds ne ""} {
foreach {var val} $binds {
set $var [ad_quotehtml $val]
}
@@ -2173,10 +2173,10 @@
ad_proc -private apm::package_version::attributes::validate_maturity { maturity } {
set error_message ""
- if { ![empty_string_p $maturity] } {
+ if { $maturity ne "" } {
if { ![regexp {^-?[0-9]+$} $maturity] } {
set error_message "Maturity must be integer"
- } elseif { [expr $maturity < -1 || $maturity > 3] } {
+ } elseif { [expr {$maturity < -1 || $maturity > 3}] } {
set error_message "Matuirity must be integer between -1 and 3"
}
}
@@ -2192,7 +2192,7 @@
} {
if {[exists_and_not_null maturity]} {
- if { ![expr $maturity >= -1 && $maturity <= 3] } {
+ if { ![expr {$maturity >= -1 && $maturity <= 3}] } {
error "Maturity must be between -1 and 3 but is \"$maturity\""
}
@@ -2233,7 +2233,7 @@
set attribute_node [xml_node_get_first_child_by_name $parent_node $attribute_name]
array set attribute $dynamic_attributes($attribute_name)
- if { ![empty_string_p $attribute_node] } {
+ if { $attribute_node ne "" } {
# There is a tag for the attribute so use the tag contents
set attributes($attribute_name) [xml_node_get_content $attribute_node]
} else {
@@ -2345,7 +2345,7 @@
# its stable for CVS.
foreach attribute_name [lsort [array names attributes]] {
# Only output tag if its value is non-empty
- if { ![empty_string_p $attributes($attribute_name)] } {
+ if { $attributes($attribute_name) ne "" } {
append xml_string "${indentation}<${attribute_name}>[ad_quotehtml $attributes($attribute_name)]</${attribute_name}>\n"
}
}
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 -r1.77 -r1.78
--- openacs-4/packages/acs-tcl/tcl/apm-procs.tcl 8 Dec 2006 14:46:00 -0000 1.77
+++ openacs-4/packages/acs-tcl/tcl/apm-procs.tcl 10 Jan 2007 21:22:12 -0000 1.78
@@ -203,7 +203,7 @@
<blockquote><pre>[list $file_id $path]</pre></blockquote>
} {
- if { ![empty_string_p $changed_files_var] } {
+ if { $changed_files_var ne "" } {
upvar $changed_files_var changed_files
}
@@ -312,7 +312,7 @@
lappend file_types test_init
}
- if { [empty_string_p $packages] } {
+ if { $packages eq "" } {
set packages [apm_enabled_packages]
}
@@ -365,7 +365,7 @@
@author Peter Marklund
} {
- if { [empty_string_p $packages] } {
+ if { $packages eq "" } {
set packages [apm_enabled_packages]
}
@@ -415,7 +415,7 @@
@author ben@mit.edu
} {
- if { [empty_string_p $packages] } {
+ if { $packages eq "" } {
set packages [apm_enabled_packages]
}
@@ -453,9 +453,9 @@
# !( 1 ^ 0 ) = Nope
# !( 1 ^ 1 ) = Yep
#
- if {![expr $test_queries_p ^ $is_test_file_p] &&
- [string equal $file_type query_file] &&
- ([empty_string_p $file_db_type] || [string equal $file_db_type [db_type]])} {
+ if {![expr {$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
}
}
@@ -737,7 +737,7 @@
} {
@return The parameter id that has been updated.
} {
- if {[empty_string_p $section_name]} {
+ if {$section_name eq ""} {
set section_name [db_null]
}
@@ -773,11 +773,11 @@
@return The parameter id of the new parameter.
} {
- if {[empty_string_p $parameter_id]} {
+ if {$parameter_id eq ""} {
set parameter_id [db_null]
}
- if {[empty_string_p $section_name]} {
+ if {$section_name eq ""} {
set section_name [db_null]
}
@@ -815,7 +815,7 @@
} {
Unregisters a parameter from the system.
} {
- if { [empty_string_p $parameter_id] } {
+ if { $parameter_id eq "" } {
set parameter_id [db_string select_parameter_id {
select parameter_id
from apm_parameters
@@ -859,7 +859,7 @@
@return The id of the new dependency.
} {
- if {[empty_string_p $dependency_id]} {
+ if {$dependency_id eq ""} {
set dependency_id [db_null]
}
@@ -900,7 +900,7 @@
@return The id of the new interface.
} {
- if {[empty_string_p $interface_id]} {
+ if {$interface_id eq ""} {
set interface_id [db_null]
}
@@ -947,7 +947,7 @@
} {
upvar $array row
- if { ![empty_string_p $package_key] } {
+ if { $package_key ne "" } {
set version_id [apm_version_id_from_package_key $package_key]
}
@@ -1035,7 +1035,7 @@
db_foreach apm_package_ids_from_key {
select package_id from apm_packages where package_key = :package_key
} {
- if {![string eq "" [site_node::get_node_id_from_object_id -object_id $package_id]]} {
+ if {"" ne [site_node::get_node_id_from_object_id -object_id $package_id] } {
lappend package_ids $package_id
}
}
@@ -1176,7 +1176,7 @@
} {
Renames a package instance
} {
- if { [empty_string_p $package_id] } {
+ if { $package_id eq "" } {
set package_id [ad_conn package_id]
}
db_transaction {
@@ -1213,8 +1213,8 @@
} {
apm_assert_callback_type_supported $type
- if { [empty_string_p $version_id] } {
- if { [empty_string_p $package_key] } {
+ if { $version_id eq "" } {
+ if { $package_key eq "" } {
error "apm_set_package_callback_proc: Invoked with both version_id and package_key empty. You must supply either of these"
}
@@ -1223,7 +1223,7 @@
set current_proc [apm_get_callback_proc -type $type -version_id $version_id]
- if { [empty_string_p $current_proc] } {
+ if { $current_proc eq "" } {
# We are adding
db_dml insert_proc {}
} else {
@@ -1247,7 +1247,7 @@
} {
apm_assert_callback_type_supported $type
- if { [empty_string_p $version_id] } {
+ if { $version_id eq "" } {
set version_id [apm_version_id_from_package_key $package_key]
}
return [db_string select_proc {} -default ""]
@@ -1314,21 +1314,21 @@
} {
array set arg_array $arg_list
- if {[empty_string_p $proc_name]} {
+ if {$proc_name eq ""} {
set proc_name [apm_get_callback_proc \
-version_id $version_id \
-package_key $package_key \
-type $type]
}
- if { [empty_string_p $proc_name] } {
- if { [string equal $type "after-instantiate"] } {
+ if { $proc_name eq "" } {
+ if {$type eq "after-instantiate"} {
# We check for the old proc on format: package_key_post_instantiation package_id
- if { [empty_string_p $package_key] } {
+ if { $package_key eq "" } {
set package_key [apm_package_key_from_version_id $version_id]
}
set proc_name [apm_post_instantiation_tcl_proc_from_key $package_key]
- if { [empty_string_p $proc_name] } {
+ if { $proc_name eq "" } {
# No callback and no old-style callback proc - no options left
return 0
}
@@ -1480,7 +1480,7 @@
append test_arg_list " -${arg_name} value"
}
- if { [empty_string_p $test_arg_list] } {
+ if { $test_arg_list eq "" } {
# The callback proc should take no args
return [empty_string_p [info args ::${proc_name}]]
}
@@ -1516,13 +1516,13 @@
@return The id of the instantiated package
} {
- if { [empty_string_p $instance_name] } {
+ if { $instance_name eq "" } {
set instance_name [db_string pretty_name_from_key {select pretty_name
from apm_enabled_package_versions
where package_key = :package_key}]
}
- if { [empty_string_p $package_id] } {
+ if { $package_id eq "" } {
set package_id [db_null]
}
@@ -1630,7 +1630,7 @@
Centralized APM logging. If you want to debug the APM, change
APMDebug to Debug and restart the server.
} {
- if {![string equal "APMDebug" $level]} {
+ if {"APMDebug" ne $level } {
ns_log $level $msg
}
}
@@ -1794,7 +1794,7 @@
set metrics(procs) [regexp -all -line -nocase {^\s*create\s+or\s+replace\s+function\s+} $filedata]
}
data_model_ora {
- set metrics(procs) [expr [regexp -all -line -nocase {^\s+function\s+} $filedata] + [regexp -all -line -nocase {^\s+procedure\s+} $filedata]]
+ set metrics(procs) [expr {[regexp -all -line -nocase {^\s+function\s+} $filedata] + [regexp -all -line -nocase {^\s+procedure\s+} $filedata]}]
}
default {
# other file-types don't have procs
Index: openacs-4/packages/acs-tcl/tcl/apm-xml-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/apm-xml-procs.tcl,v
diff -u -r1.25 -r1.26
--- openacs-4/packages/acs-tcl/tcl/apm-xml-procs.tcl 26 Apr 2004 18:50:53 -0000 1.25
+++ openacs-4/packages/acs-tcl/tcl/apm-xml-procs.tcl 10 Jan 2007 21:22:12 -0000 1.26
@@ -16,7 +16,7 @@
} {
set value [apm_attribute_value $element $attribute]
- if { [empty_string_p $value] } {
+ if { $value eq "" } {
error "Required attribute \"$attribute\" missing from <[xml_node_get_name $element]>"
}
return $value
@@ -46,7 +46,7 @@
ns_log Debug "apm_tag_value [$root nodeName] $property_name"
set node [xml_node_get_first_child_by_name $root $property_name]
- if { ![empty_string_p $node] } {
+ if { $node ne "" } {
return [xml_node_get_content $node]
}
ns_log Debug "apm_tag_value $root $property_name $default --> $default"
@@ -77,29 +77,29 @@
db_foreach owner_info {} {
append spec " <owner"
- if { ![empty_string_p $owner_uri] } {
+ if { $owner_uri ne "" } {
append spec " url=\"[ad_quotehtml $owner_uri]\""
}
append spec ">[ad_quotehtml $owner_name]</owner>\n"
}
apm_log APMDebug "APM: Writing Version summary and description"
- if { ![empty_string_p $summary] } {
+ if { $summary ne "" } {
append spec " <summary>[ad_quotehtml $summary]</summary>\n"
}
- if { ![empty_string_p $release_date] } {
+ if { $release_date ne "" } {
append spec " <release-date>[ad_quotehtml [string range $release_date 0 9]]</release-date>\n"
}
- if { ![empty_string_p $vendor] || ![empty_string_p $vendor_uri] } {
+ if { $vendor ne "" || $vendor_uri ne "" } {
append spec " <vendor"
- if { ![empty_string_p $vendor_uri] } {
+ if { $vendor_uri ne "" } {
append spec " url=\"[ad_quotehtml $vendor_uri]\""
}
append spec ">[ad_quotehtml $vendor]</vendor>\n"
}
- if { ![empty_string_p $description] } {
+ if { $description ne "" } {
append spec " <description"
- if { ![empty_string_p $description_format] } {
+ if { $description_format ne "" } {
append spec " format=\"[ad_quotehtml $description_format]\""
}
append spec ">[ad_quotehtml $description]</description>\n"
@@ -132,15 +132,15 @@
min_n_values=\"[ad_quotehtml $min_n_values]\" \
max_n_values=\"[ad_quotehtml $max_n_values]\" \
name=\"[ad_quotehtml $parameter_name]\" "
- if { ![empty_string_p $default_value] } {
+ if { $default_value ne "" } {
append spec " default=\"[ad_quotehtml $default_value]\""
}
- if { ![empty_string_p $description] } {
+ if { $description ne "" } {
append spec " description=\"[ad_quotehtml $description]\""
}
- if { ![empty_string_p $section_name] } {
+ if { $section_name ne "" } {
append spec " section_name=\"[ad_quotehtml $section_name]\""
}
@@ -246,7 +246,7 @@
apm_log APMDebug "XML - one root child: [xml_node_get_name $child]"
}
- if { ![string equal $root_name "package"] } {
+ if { $root_name ne "package" } {
apm_log APMDebug "XML: the root name is $root_name"
error "Expected <package> as root node"
}
@@ -290,7 +290,7 @@
description format
} {
set node [xml_node_get_first_child_by_name $version $property_name]
- if { ![empty_string_p $node] } {
+ if { $node ne "" } {
set properties($property_name.$attribute_name) [apm_attribute_value $node $attribute_name]
} else {
set properties($property_name.$attribute_name) ""
@@ -314,7 +314,7 @@
set service_uri [apm_required_attribute_value $node url]
set service_version [apm_required_attribute_value $node version]
# Package always provides itself, we'll add that below, so don't add it here
- if { ![string equal $dependency_type provides] || ![string equal $service_uri $properties(package.key)] } {
+ if { $dependency_type ne "provides" || ![string equal $service_uri $properties(package.key)] } {
lappend properties($dependency_type) [list $service_uri $service_version]
}
}
Index: openacs-4/packages/acs-tcl/tcl/application-link-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/application-link-procs.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-tcl/tcl/application-link-procs.tcl 27 Jul 2006 01:39:15 -0000 1.5
+++ openacs-4/packages/acs-tcl/tcl/application-link-procs.tcl 10 Jan 2007 21:22:12 -0000 1.6
@@ -93,19 +93,19 @@
set from_package_id [apm_attribute_value -default "" $node from-package-id]
set to_package_id [apm_attribute_value -default "" $node to-package-id]
- if {![string equal $this_package_url ""]} {
+ if {$this_package_url ne "" } {
set this_package_id [site_node::get_element -url $this_package_url \
-element package_id]
- } elseif {![string equal $from_package_id ""]} {
+ } elseif {$from_package_id ne "" } {
set this_package_id [install::xml::util::get_id $from_package_id]
} else {
error "application-link tag must specify either this_package_url or from-package-id"
}
- if {![string equal $target_package_url ""]} {
+ if {$target_package_url ne "" } {
set target_package_id [site_node::get_element -url $target_package_url \
-element package_id]
- } elseif {![string equal $to_package_id ""]} {
+ } elseif {$to_package_id ne "" } {
set target_package_id [install::xml::util::get_id $to_package_id]
} else {
error "application-link tag must specify either target_package_url or to-package-id"
Index: openacs-4/packages/acs-tcl/tcl/base64-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/Attic/base64-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-tcl/tcl/base64-procs.tcl 15 Dec 2006 00:02:00 -0000 1.4
+++ openacs-4/packages/acs-tcl/tcl/base64-procs.tcl 10 Jan 2007 21:22:12 -0000 1.5
@@ -92,7 +92,7 @@
append res [string range $result 0 $edge]$wrapchar
set result [string range $result $maxlen end]
}
- if {[string length $result] > 0} {
+ if {$result ne ""} {
append res $result
}
set result $res
@@ -275,7 +275,7 @@
# The decoded value.
proc ::base64::decode {string} {
- if {[string length $string] == 0} {return ""}
+ if {$string eq ""} {return ""}
set base64 $::base64::base64
Index: openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl,v
diff -u -r1.48 -r1.49
--- openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl 4 Jun 2006 00:45:47 -0000 1.48
+++ openacs-4/packages/acs-tcl/tcl/community-core-procs.tcl 10 Jan 2007 21:22:12 -0000 1.49
@@ -80,19 +80,19 @@
@see auth::create_user
@see auth::create_local_account
} {
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
set user_id [db_nextval acs_object_id_seq]
}
- if { [empty_string_p $password_question] } {
+ if { $password_question eq "" } {
set password_question [db_null]
}
- if { [empty_string_p $password_answer] } {
+ if { $password_answer eq "" } {
set password_answer [db_null]
}
- if { [empty_string_p $url] } {
+ if { $url eq "" } {
set url [db_null]
}
@@ -206,7 +206,7 @@
} {
if {$person_id eq "" && $email eq ""} {
error "You need to provide either person_id or email"
- } elseif {![string eq "" $person_id] && ![string eq "" $email]} {
+ } elseif {"" ne $person_id && "" ne $email } {
error "Only provide provide person_id OR email, not both"
} else {
return [util_memoize [list person::name_not_cached -person_id $person_id -email $email]]
@@ -266,11 +266,11 @@
@author Lars Pind (lars@collaboraid.biz)
} {
- if { [empty_string_p $person_id] } {
+ if { $person_id eq "" } {
set person_id [ad_conn user_id]
}
- if { ![empty_string_p $exists_var] } {
+ if { $exists_var ne "" } {
upvar $exists_var exists_p
}
@@ -305,9 +305,9 @@
# There is no bio yet.
# If new bio is empty, that's a don't change (1)
# If new bio is non-empty, that's an insert (0)
- set bio_change_to [empty_string_p $bio]
+ set bio_change_to [expr {$bio eq ""}]
} else {
- if { [string equal $bio $bio_old] } {
+ if {$bio eq $bio_old} {
set bio_change_to 1
} else {
set bio_change_to 2
@@ -333,7 +333,7 @@
} {
set rel_id [db_string select_rel_id {*SQL*} -default {}]
- if {[empty_string_p $rel_id]} {
+ if {$rel_id eq ""} {
return
}
@@ -403,7 +403,7 @@
@return user_id of the user, or the empty string if no user found.
} {
# Default to local authority
- if { [empty_string_p $authority_id] } {
+ if { $authority_id eq "" } {
set authority_id [auth::authority::local]
}
@@ -459,18 +459,18 @@
@author Lars Pind (lars@collaboraid.biz)
} {
- if { [empty_string_p $user_id] } {
- if { [empty_string_p $username] } {
+ if { $user_id eq "" } {
+ if { $username eq "" } {
set user_id [ad_conn user_id]
} else {
- if { [empty_string_p $authority_id] } {
+ if { $authority_id eq "" } {
set authority_id [auth::authority::local]
}
}
}
upvar $array row
- if { ![empty_string_p $user_id] } {
+ if { $user_id ne "" } {
array set row [util_memoize [list acs_user::get_from_user_id_not_cached $user_id] [cache_timeout]]
} else {
array set row [util_memoize [list acs_user::get_from_username_not_cached $username $authority_id] [cache_timeout]]
@@ -611,7 +611,7 @@
@author Peter Marklund
} {
- if { [empty_string_p $user_id]} {
+ if { $user_id eq ""} {
set user_id [ad_conn user_id]
}
@@ -691,7 +691,7 @@
@author Peter Marklund
} {
- if { ![empty_string_p $object_type] } {
+ if { $object_type ne "" } {
set from_clause ", acs_objects ao"
set where_clause "and pamm.member_id = ao.object_id
and ao.object_type = :object_type"
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 -r1.53 -r1.54
--- openacs-4/packages/acs-tcl/tcl/defs-procs.tcl 3 Nov 2006 23:24:57 -0000 1.53
+++ openacs-4/packages/acs-tcl/tcl/defs-procs.tcl 10 Jan 2007 21:22:12 -0000 1.54
@@ -149,7 +149,7 @@
@return the link of the community member page of a particular user
@see acs_community_member_url
} {
- if {[empty_string_p $label]} {
+ if {$label eq ""} {
acs_user::get -user_id $user_id -array user
set label "$user(first_names) $user(last_name)"
}
@@ -189,7 +189,7 @@
} {
@return the HTML link of the community member page of a particular admin user.
} {
- if {[empty_string_p $label]} {
+ if {$label eq ""} {
set label [db_string select_community_member_link_label {
select persons.first_names || ' ' || persons.last_name
from persons
@@ -259,7 +259,7 @@
set attrs(bgcolor) [ad_parameter -package_id [ad_acs_kernel_id] bgcolor "" "white"]
set attrs(text) [ad_parameter -package_id [ad_acs_kernel_id] textcolor "" "black"]
- if { ![empty_string_p $focus] } {
+ if { $focus ne "" } {
set attrs(onLoad) "javascript:document.${focus}.focus()"
}
@@ -284,7 +284,7 @@
@see Documentation on the site master template for the proper way to standardize page footers
} {
global sidegraphic_displayed_p
- if { [empty_string_p $signatory] } {
+ if { $signatory eq "" } {
set signatory [ad_system_owner]
}
if { [info exists sidegraphic_displayed_p] && $sidegraphic_displayed_p } {
@@ -491,7 +491,7 @@
if { $n_matches > $max_simultaneous_copies } {
ad_return_warning "Too many copies" "This is an expensive page for our server, which is already running the same program on behalf of some other users. Please try again at a less busy hour."
# blow out of the caller as well
- if $call_adp_break_p {
+ if {$call_adp_break_p} {
# we were called from an ADP page; we have to abort processing
ns_adp_break
}
@@ -516,16 +516,16 @@
@author Roberto Mello
} {
set lines [list]
- if { [empty_string_p $line2] } {
+ if { $line2 eq "" } {
lappend lines $line1
- } elseif { [empty_string_p $line1] } {
+ } elseif { $line1 eq "" } {
lappend lines $line2
} else {
lappend lines $line1
lappend lines $line2
}
lappend lines "$city, $state $postal_code"
- if { ![empty_string_p $country_code] && $country_code != "us" } {
+ if { $country_code ne "" && $country_code ne "us" } {
lappend lines [ad_country_name_from_country_code $country_code]
}
return [join $lines "\n"]
@@ -567,7 +567,7 @@
string, ad_decorate_top will make a one-row table for the
top of the page
} {
- if { [empty_string_p $potential_decoration] } {
+ if { $potential_decoration eq "" } {
return $simple_headline
} else {
return "<table cellspacing=10><tr><td>$potential_decoration<td>$simple_headline</tr></table>"
@@ -585,7 +585,7 @@
set package_id [ad_conn package_id]
}
- if { [empty_string_p $package_id] } {
+ if { $package_id eq "" } {
if { [catch {
set package_id [ad_acs_kernel_id]
}] } {
@@ -651,7 +651,7 @@
# The below is really a hack because none of the calls to ad_parameter in the system
# actually call 'ad_parameter param_name acs-kernel'.
- if { [empty_string_p $package_key] || $package_key == "acs-kernel"} {
+ if { $package_key eq "" || $package_key eq "acs-kernel"} {
set ns_param [ns_config "ns/server/[ns_info server]/acs" $name]
} else {
set ns_param [ns_config "ns/server/[ns_info server]/acs/$package_key" $name]
Index: openacs-4/packages/acs-tcl/tcl/document-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/document-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-tcl/tcl/document-procs.tcl 29 Dec 2003 20:08:52 -0000 1.3
+++ openacs-4/packages/acs-tcl/tcl/document-procs.tcl 10 Jan 2007 21:22:12 -0000 1.4
@@ -23,7 +23,7 @@
set lines [split $properties \n]
foreach line_raw $lines {
set line [string trim $line_raw]
- if { [empty_string_p $line] } {
+ if { $line eq "" } {
continue
}
@@ -40,7 +40,7 @@
are not Unicode word characters, but we don't allow that."
}
- if { [info exists type_raw] && ![empty_string_p $type_raw] } {
+ if { [info exists type_raw] && $type_raw ne "" } {
set type [string trim $type_raw]
} else {
set type onevalue
@@ -62,7 +62,7 @@
set column_list [list]
foreach column_raw $column_split {
set column [string trim $column_raw]
- if { [empty_string_p $column] } {
+ if { $column eq "" } {
return -code error "You have an empty column name in\
the definition of the $property property in the\
type $type"
@@ -162,7 +162,7 @@
set adp [ns_adp_parse -file $__template_path]
set content_type [ns_set iget [ad_conn outputheaders] "content-type"]
- if { [empty_string_p $content_type] } {
+ if { $content_type eq "" } {
set content_type "text/html"
}
doc_return 200 $content_type $adp
@@ -174,7 +174,7 @@
}
set mime_type [doc_get_property mime_type]
- if { [empty_string_p $mime_type] } {
+ if { $mime_type eq "" } {
if { [doc_property_exists_p title] } {
set mime_type "text/html;content-pane"
} else {
@@ -186,7 +186,7 @@
text/html;content-pane - text/x-html-content-pane {
# It's a content pane. Find the appropriate template.
set template_path [doc_find_template [ad_conn file]]
- if { [empty_string_p $template_path] } {
+ if { $template_path eq "" } {
ns_returnerror 500 "Unable to find master template"
ns_log error \
"Unable to find master template for file '[ad_conn file]'"
@@ -211,7 +211,7 @@
proc doc_tag_ad_property { contents params } {
set name [ns_set iget $params name]
- if { [empty_string_p $name] } {
+ if { $name eq "" } {
return "<em>No <tt>name</tt> property in <tt>AD-PROPERTY</tt> tag</em>"
}
doc_set_property $name $contents
Index: openacs-4/packages/acs-tcl/tcl/ds-stub-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/ds-stub-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-tcl/tcl/ds-stub-procs.tcl 4 Mar 2005 23:09:17 -0000 1.1
+++ openacs-4/packages/acs-tcl/tcl/ds-stub-procs.tcl 10 Jan 2007 21:22:12 -0000 1.2
@@ -12,12 +12,12 @@
@cvs-id $Id$
}
-if {[string equal {} [info procs ds_add]]} {
+if {{} eq [info procs ds_add]} {
proc ds_add {args} {}
}
-if {[string equal {} [info procs ds_collect_db_call]]} {
+if {{} eq [info procs ds_collect_db_call]} {
proc ds_collect_db_call {args} {}
}
-if {[string equal {} [info procs ds_collect_connection_info]]} {
+if {{} eq [info procs ds_collect_connection_info]} {
proc ds_collect_connection_info {} {}
}
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 -r1.2 -r1.3
--- openacs-4/packages/acs-tcl/tcl/exception-procs.tcl 14 Feb 2005 12:32:07 -0000 1.2
+++ openacs-4/packages/acs-tcl/tcl/exception-procs.tcl 10 Jan 2007 21:22:12 -0000 1.3
@@ -44,10 +44,10 @@
}
}
- if $matched {
- upvar [lindex $args [expr $i + 1]] var
+ if {$matched} {
+ upvar [lindex $args [expr {$i + 1}]] var
set var $result
- set errno [catch {uplevel [lindex $args [expr $i + 2]]} result]
+ set errno [catch {uplevel [lindex $args [expr {$i + 2}]]} 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 -r1.57 -r1.58
--- openacs-4/packages/acs-tcl/tcl/form-processing-procs.tcl 1 Nov 2006 19:12:54 -0000 1.57
+++ openacs-4/packages/acs-tcl/tcl/form-processing-procs.tcl 10 Jan 2007 21:22:12 -0000 1.58
@@ -511,7 +511,7 @@
# Are we extending the form?
- if { [string equal [lindex $args 0] "-extend"] } {
+ if {[lindex $args 0] eq "-extend"} {
set extend_p 1
set args [lrange $args 1 end]
} else {
@@ -608,7 +608,7 @@
# This can easily be generalized if we add more embeddable form commands ...
- if { [string equal $element_name_part "-section"] } {
+ if {$element_name_part eq "-section"} {
lappend af_element_names($form_name) "[list "-section" [uplevel [list subst [lindex $element 1]]]]"
} else {
set element_name_part [uplevel [list subst $element_name_part]]
@@ -626,11 +626,11 @@
set af_element_parameters($element_name:$flag) [list]
set left_paren [string first "(" $flag]
if { $left_paren != -1 } {
- if { ![string equal [string index $flag end] ")"] } {
+ if { [string index $flag end] ne ")" } {
return -code error "Missing or misplaced end parenthesis for flag '$flag' on argument '$element_name'"
}
- set flag_stem [string range $flag 0 [expr $left_paren - 1]]
- lappend af_element_parameters($element_name:$flag_stem) [string range $flag [expr $left_paren + 1] [expr [string length $flag]-2]]
+ set flag_stem [string range $flag 0 [expr {$left_paren - 1}]]
+ lappend af_element_parameters($element_name:$flag_stem) [string range $flag [expr {$left_paren + 1}] [expr {[string length $flag]-2}]]
lappend af_flag_list(${form_name}__$element_name) $flag_stem
} else {
lappend af_flag_list(${form_name}__$element_name) $flag
@@ -777,7 +777,7 @@
return -code error "element $element_name: a form can only declare one key"
}
set af_key_name($form_name) $element_name
- if { ![empty_string_p $af_element_parameters($element_name:key)] } {
+ if { $af_element_parameters($element_name:key) ne "" } {
if { [info exists af_sequence_name($form_name)] } {
return -code error "element $element_name: duplicate sequence"
}
@@ -789,14 +789,14 @@
}
multiple {
- if { ![empty_string_p $af_element_parameters($element_name:$flag)] } {
+ if { $af_element_parameters($element_name:$flag) ne "" } {
return -code error "element $element_name: $flag attribute can not have a parameter"
}
}
nospell -
optional {
- if { ![empty_string_p $af_element_parameters($element_name:$flag)] } {
+ if { $af_element_parameters($element_name:$flag) ne "" } {
return -code error "element $element_name: $flag attribute can not have a parameter"
}
lappend form_command "-$flag"
@@ -805,7 +805,7 @@
from_sql -
to_sql -
to_html {
- if { [empty_string_p $af_element_parameters($element_name:$flag)] } {
+ if { $af_element_parameters($element_name:$flag) eq "" } {
return -code error "element $element_name: \"$flag\" attribute must have a parameter"
}
set name af_$flag
@@ -824,7 +824,7 @@
lappend form_command "-datatype"
lappend form_command $flag
set af_type(${form_name}__$element_name) $flag
- if { [empty_string_p $af_element_parameters($element_name:$flag)] } {
+ if { $af_element_parameters($element_name:$flag) eq "" } {
if { ![empty_string_p [info command "::template::widget::$flag"]] } {
lappend form_command "-widget" $flag
}
@@ -1252,6 +1252,6 @@
set form [ns_getform]
- return [expr {[empty_string_p $form] || [ns_set find $form $key] == -1 || [ns_set get $form __new_p] == 1 }]
+ return [expr {$form eq "" || [ns_set find $form $key] == -1 || [ns_set get $form __new_p] == 1 }]
}
Index: openacs-4/packages/acs-tcl/tcl/html-email-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/html-email-procs.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-tcl/tcl/html-email-procs.tcl 6 Oct 2006 13:39:40 -0000 1.9
+++ openacs-4/packages/acs-tcl/tcl/html-email-procs.tcl 10 Jan 2007 21:22:12 -0000 1.10
@@ -116,7 +116,7 @@
# Expand any first-level multipart/alternative children.
set expanded_parts [list]
foreach part $parts {
- if { [string equal [mime::getproperty $part content] "multipart/alternative" ] } {
+ if {[mime::getproperty $part content] eq "multipart/alternative"} {
foreach child_part [mime::getproperty $part parts] {
lappend expanded_parts $child_part
}
Index: openacs-4/packages/acs-tcl/tcl/install-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/install-procs.tcl,v
diff -u -r1.19 -r1.20
--- openacs-4/packages/acs-tcl/tcl/install-procs.tcl 4 Jun 2006 00:45:47 -0000 1.19
+++ openacs-4/packages/acs-tcl/tcl/install-procs.tcl 10 Jan 2007 21:22:12 -0000 1.20
@@ -38,7 +38,7 @@
set src [apm_required_attribute_value $node src]
set type [apm_attribute_value -default {} $node type]
- if {[string equal $type ""]} {
+ if {$type eq ""} {
switch -glob $src {
*.tcl { set type tcl }
*.sql { set type sql }
@@ -49,15 +49,15 @@
set params [xml_node_get_children [lindex $node 0]]
foreach param $params {
- if {![string equal [xml_node_get_name $param] param]} {
+ if {[xml_node_get_name $param] ne "param" } {
error "Unknown xml element \"[xml_node_get_name $param]\""
}
set name [apm_required_attribute_value $param name]
set id [apm_attribute_value -default {} $param id]
set value [apm_attribute_value -default {} $param value]
- if {![string equal $id ""]} {
+ if {$id ne "" } {
set value [install::xml::util::get_id $id]
}
@@ -174,21 +174,21 @@
[string equal $mount_point "/"]} {
array set site_node [site_node::get -url "/"]
- if { ![empty_string_p $site_node(object_id)] } {
+ if { $site_node(object_id) ne "" } {
ns_log Error "A package is already mounted at \"$mount_point\""
ns_write "<br>mount: A package is already mounted at \"$mount_point\", ignoring mount command."
set node_id ""
}
- if {[string equal $context_id ""]} {
+ if {$context_id eq ""} {
set context_id default_context
}
set context_id [install::xml::util::get_id $context_id]
} else {
regexp {(.*)/([^/]*)$} $mount_point match parent_url mount_point
- if {[string eq $parent_url ""]} {
+ if {$parent_url eq ""} {
set parent_url /
}
@@ -203,7 +203,7 @@
# There is already a node with that path, check if there is a
# package mounted there
array set site_node [site_node::get -url "/$mount_point"]
- if { [empty_string_p $site_node(object_id)] } {
+ if { $site_node(object_id) eq "" } {
# There is no package mounted there so go ahead and mount the
# new package
set node_id $site_node(node_id)
@@ -214,12 +214,12 @@
}
}
- if {![string equal $context_id ""]} {
+ if {$context_id ne "" } {
set context_id [install::xml::util::get_id $context_id]
}
}
- if { ![empty_string_p $node_id] } {
+ if { $node_id ne "" } {
lappend out "Mounting new instance of package $package_key at /$mount_point"
set package_id [site_node::instantiate_and_mount \
-node_id $node_id \
@@ -232,7 +232,7 @@
permission::set_not_inherit -object_id $package_id
}
- if {![string equal $id ""]} {
+ if {$id ne "" } {
set ::install::xml::ids($id) $package_id
}
}
@@ -258,15 +258,15 @@
[string equal $mount_point "/"]} {
array set site_node [site_node::get -url "/"]
- if { ![empty_string_p $site_node(object_id)] } {
+ if { $site_node(object_id) ne "" } {
ns_log Error "A package is already mounted at \"$mount_point\""
ns_write "<br>mount: A package is already mounted at \"$mount_point\", ignoring mount command."
set node_id ""
}
} else {
regexp {(.*)/([^/]*)$} $mount_point match parent_url mount_point
- if {[string eq $parent_url ""]} {
+ if {$parent_url eq ""} {
set parent_url /
}
@@ -281,7 +281,7 @@
# There is already a node with that path, check if there is a
# package mounted there
array set site_node [site_node::get -url "/$mount_point"]
- if { [empty_string_p $site_node(object_id)] } {
+ if { $site_node(object_id) eq "" } {
# There is no package mounted there so go ahead and mount the
# new package
set node_id $site_node(node_id)
@@ -293,12 +293,12 @@
}
}
- if { ![empty_string_p $node_id] } {
+ if { $node_id ne "" } {
lappend out "Mounting existing package $package_id at /$mount_point"
- if { ![string equal $package_id ""] } {
+ if { $package_id ne "" } {
set package_id [install::xml::util::get_id $package_id]
- } elseif { ![string equal $package_key ""] } {
+ } elseif { $package_key ne "" } {
set package_id [apm_package_id_from_key $package_key]
}
@@ -320,7 +320,7 @@
set instance_name [apm_attribute_value -default "" $node name]
set context_id [apm_attribute_value -default "" $node context-id]
- if {[string equal $context_id ""]} {
+ if {$context_id eq ""} {
set context_id [db_null]
} else {
set context_id [install::xml::util::get_id $context_id]
@@ -499,7 +499,7 @@
-username $username \
-array user_info]
- if {[string equal $result(creation_status) "ok"]} {
+ if {$result(creation_status) eq "ok"} {
# Need to find out which username was set
set username $result(username)
@@ -531,8 +531,8 @@
]
}
- if {[string equal $result(creation_status) "ok"]} {
- if {![string equal $id ""]} {
+ if {$result(creation_status) eq "ok"} {
+ if {$id ne "" } {
set ::install::xml::ids($id) $result(user_id)
}
@@ -552,7 +552,7 @@
set user_nodes [xml_node_get_children [lindex $node 0]]
foreach node $user_nodes {
- if {![string equal [xml_node_get_name $node] user]} {
+ if {[xml_node_get_name $node] ne "user" } {
error "Unknown xml element \"[xml_node_get_name $node]\""
}
@@ -604,23 +604,23 @@
set url [apm_attribute_value -default "" $node url]
set package_key [apm_attribute_value -default "" $node package-key]
- if {[string equal $package_key ""]} {
+ if {$package_key eq ""} {
set package_key [apm_attribute_value -default "" $node package]
}
# Remove double slashes
regsub -all {//} $url "/" url
- if { ![string equal $package_key ""] && ![string equal $url ""] } {
+ if { $package_key ne "" && $url ne "" } {
error "set-parameter: Can't specify both package and url for $url and $package_key"
- } elseif { ![string equal $id ""] } {
+ } elseif { $id ne "" } {
if {[string is integer $id]} {
return $id
} else {
return [install::xml::util::get_id $id]
}
- } elseif { ![string equal $package_key ""] } {
+ } elseif { $package_key ne "" } {
return [apm_package_id_from_key $package_key]
} else {
@@ -640,17 +640,17 @@
set group_type [apm_attribute_value -default "group" $node type]
set relation_type [apm_attribute_value -default "membership_rel" $node relation]
- if {[string equal $group_type "group"]} {
+ if {$group_type eq "group"} {
set id [apm_required_attribute_value $node group-id]
- } elseif {[string equal $group_type "rel_segment"]} {
+ } elseif {$group_type eq "rel_segment"} {
set id [apm_required_attribute_value $node parent-id]
}
set group_id [install::xml::util::get_id $id]
- if {[string equal $group_type "group"]} {
+ if {$group_type eq "group"} {
return $group_id
- } elseif {[string equal $group_type "rel_segment"]} {
+ } elseif {$group_type eq "rel_segment"} {
return [group::get_rel_segment -group_id $group_id -type $relation_type]
}
}
@@ -671,9 +671,9 @@
set group_id [application_group::group_id_from_package_id \
-package_id $package_id]
- if {[string equal $group_type "group"]} {
+ if {$group_type eq "group"} {
return $group_id
- } elseif {[string equal $group_type "rel_segment"]} {
+ } elseif {$group_type eq "rel_segment"} {
return [group::get_rel_segment -group_id $group_id -type $relation_type]
}
}
Index: openacs-4/packages/acs-tcl/tcl/md5-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/Attic/md5-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-tcl/tcl/md5-procs.tcl 15 Dec 2006 00:02:00 -0000 1.3
+++ openacs-4/packages/acs-tcl/tcl/md5-procs.tcl 10 Jan 2007 21:22:12 -0000 1.4
@@ -168,10 +168,10 @@
# 3.3 Step 3. Initialize MD Buffer
#
- set A [expr 0x67452301]
- set B [expr 0xefcdab89]
- set C [expr 0x98badcfe]
- set D [expr 0x10325476]
+ set A [expr {0x67452301}]
+ set B [expr {0xefcdab89}]
+ set C [expr {0x98badcfe}]
+ set D [expr {0x10325476}]
#
# 3.4 Step 4. Process Message in 16-Word Blocks
Index: openacs-4/packages/acs-tcl/tcl/membership-rel-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/membership-rel-procs.tcl,v
diff -u -r1.7 -r1.8
--- openacs-4/packages/acs-tcl/tcl/membership-rel-procs.tcl 4 Jun 2006 00:45:47 -0000 1.7
+++ openacs-4/packages/acs-tcl/tcl/membership-rel-procs.tcl 10 Jan 2007 21:22:12 -0000 1.8
@@ -27,7 +27,7 @@
# If user is being undeleted - remove him from the public group
acs_user::get -user_id $rel_user_id -array user
- if { [string equal $user(member_state) "deleted"] && [string equal $state "approved"] } {
+ if { $user(member_state) eq "deleted" && $state eq "approved" } {
group::remove_member \
-group_id [acs_magic_object the_public] \
-user_id $rel_user_id
@@ -64,7 +64,7 @@
db_dml update_modifying_user {}
}
- if { ![empty_string_p $rel_user_id] } {
+ if { $rel_user_id ne "" } {
acs_user::flush_cache -user_id $rel_user_id
}
}
Index: openacs-4/packages/acs-tcl/tcl/memoize-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/memoize-procs.tcl,v
diff -u -r1.10 -r1.11
--- openacs-4/packages/acs-tcl/tcl/memoize-procs.tcl 4 Jun 2006 00:45:47 -0000 1.10
+++ openacs-4/packages/acs-tcl/tcl/memoize-procs.tcl 10 Jan 2007 21:22:12 -0000 1.11
@@ -29,15 +29,15 @@
@return The possibly-cached value returned by <i>script</i>.
} {
- if {![string equal $max_age ""] && $max_age < 0} {
+ if {$max_age ne "" && $max_age < 0} {
error "max_age must not be negative"
}
set current_time [ns_time]
set cached_p [ns_cache get util_memoize $script pair]
- if {$cached_p && [string compare $max_age ""] != 0} {
+ if {$cached_p && $max_age ne "" } {
set cache_time [lindex $pair 0]
if {$current_time - $cache_time > $max_age} {
ns_cache flush util_memoize $script
@@ -99,7 +99,7 @@
return 0
}
- if {[string equal $max_age ""]} {
+ if {$max_age eq ""} {
return 1
} else {
set cache_time [lindex $pair 0]
@@ -129,11 +129,11 @@
} {
foreach name [ns_cache names util_memoize] {
- if $log_p {
+ if {$log_p} {
ns_log Debug "util_memoize_flush_regexp: checking $name for $expr"
}
if { [regexp $expr $name] } {
- if $log_p {
+ if {$log_p} {
ns_log Debug "util_memoize_flush_regexp: flushing $name"
}
util_memoize_flush $name
Index: openacs-4/packages/acs-tcl/tcl/mime-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/Attic/mime-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-tcl/tcl/mime-procs.tcl 15 Dec 2006 00:02:00 -0000 1.4
+++ openacs-4/packages/acs-tcl/tcl/mime-procs.tcl 10 Jan 2007 21:22:12 -0000 1.5
@@ -188,7 +188,7 @@
array set encodings $encList
variable reversemap
foreach {enc mimeType} $encList {
- if {$mimeType != ""} {
+ if {$mimeType ne ""} {
set reversemap([string tolower $mimeType]) $enc
}
}
@@ -333,14 +333,14 @@
error "-header expects a key and a value, not $value"
}
set lower [string tolower [set mixed [lindex $value 0]]]
- if {![string compare $lower content-type]} {
+ if {$lower eq "content-type" } {
error "use -canonical instead of -header $value"
}
- if {![string compare $lower content-transfer-encoding]} {
+ if {$lower eq "content-transfer-encoding" } {
error "use -encoding instead of -header $value"
}
- if {(![string compare $lower content-md5]) \
- || (![string compare $lower mime-version])} {
+ if {($lower eq "content-md5" ) \
+ || ($lower eq "mime-version" )} {
error "don't go there..."
}
if {[lsearch -exact $state(lowerL) $lower] < 0} {
@@ -428,7 +428,7 @@
}
default {
- if {[string compare $state(encoding) ""]} {
+ if {$state(encoding) ne "" } {
error "-encoding and -parts do not mix"
}
}
@@ -451,13 +451,13 @@
return
}
- if {[string compare $state(params) ""]} {
+ if {$state(params) ne "" } {
error "-param requires -canonical"
}
- if {[string compare $state(encoding) ""]} {
+ if {$state(encoding) ne "" } {
error "-encoding requires -canonical"
}
- if {[string compare $state(header) ""]} {
+ if {$state(header) ne "" } {
error "-header requires -canonical"
}
if {[info exists state(parts)]} {
@@ -559,7 +559,7 @@
continue
}
- if {![string compare $vline ""]} {
+ if {$vline eq "" } {
if {$blankP} {
break
}
@@ -630,7 +630,7 @@
set state(params) [list charset us-ascii]
}
- if {![string match multipart/* $state(content)]} {
+ if {![string match "multipart/*" $state(content)]} {
if {$fileP} {
set x [tell $state(fd)]
incr state(count) [expr {$state(offset)-$x}]
@@ -641,7 +641,7 @@
$state(lines.current) end] "\n"]
}
- if {[string match message/* $state(content)]} {
+ if {[string match "message/*" $state(content)]} {
# FRINK: nocheck
variable [set child $token-[incr state(cid)]]
@@ -665,15 +665,15 @@
set boundary ""
foreach {k v} $state(params) {
- if {![string compare $k boundary]} {
+ if {$k eq "boundary" } {
set boundary $v
break
}
}
- if {![string compare $boundary ""]} {
+ if {$boundary eq "" } {
error "boundary parameter is missing in $state(content)"
}
- if {![string compare [string trim $boundary] ""]} {
+ if {[string trim $boundary] eq "" } {
error "boundary parameter is empty in $state(content)"
}
@@ -719,7 +719,7 @@
}
if {!$inP} {
- if {![string compare $line "--$boundary"]} {
+ if {$line eq "--$boundary" } {
set inP 1
if {$fileP} {
set start $pos
@@ -821,7 +821,7 @@
variable $token
upvar 0 $token state
- if {[string compare [parselexeme $token] LX_ATOM]} {
+ if {[parselexeme $token] ne "LX_ATOM" } {
error [format "expecting type (found %s)" $state(buffer)]
}
set type [string tolower $state(buffer)]
@@ -831,7 +831,7 @@
}
LX_END {
- if {[string compare $type message]} {
+ if {$type ne "message" } {
error "expecting type/subtype (found $type)"
}
@@ -843,7 +843,7 @@
}
}
- if {[string compare [parselexeme $token] LX_ATOM]} {
+ if {[parselexeme $token] ne "LX_ATOM" } {
error [format "expecting subtype (found %s)" $state(buffer)]
}
append type [string tolower /$state(buffer)]
@@ -878,7 +878,7 @@
set attribute [string tolower $state(buffer)]
- if {[string compare [parselexeme $token] LX_EQUALS]} {
+ if {[parselexeme $token] ne "LX_EQUALS" } {
error [format "expecting \"=\" (found %s)" $state(buffer)]
}
@@ -926,7 +926,7 @@
switch -- $options(-subordinates) {
all {
- if {![string compare $state(value) parts]} {
+ if {$state(value) eq "parts" } {
foreach part $state(parts) {
eval [list mime::finalize $part] $args
}
@@ -1085,7 +1085,7 @@
}
}
- if {![string compare $state(encoding) base64]} {
+ if {$state(encoding) eq "base64" } {
set size [expr {($size*3+2)/4}]
}
@@ -1336,7 +1336,7 @@
end]
}
}
- if {[string length $fragment] > 0} {
+ if {$fragment ne ""} {
uplevel #0 $options(-command) [list data $fragment]
}
} result]
@@ -1397,7 +1397,7 @@
set fragment [string range $fragment \
$options(-blocksize) end]
}
- if {[string length $fragment] > 0} {
+ if {$fragment ne ""} {
uplevel #0 $options(-command) [list data $fragment]
}
} result]
@@ -1528,7 +1528,7 @@
array set header $state(header)
- if {[string compare $state(version) ""]} {
+ if {$state(version) ne "" } {
puts $channel "MIME-Version: $state(version)"
}
foreach lower $state(lowerL) mixed $state(mixedL) {
@@ -1544,7 +1544,7 @@
puts -nonewline $channel "Content-Type: $state(content)"
set boundary ""
foreach {k v} $state(params) {
- if {![string compare $k boundary]} {
+ if {$k eq "boundary" } {
set boundary $v
}
@@ -1553,14 +1553,14 @@
set converter ""
set encoding ""
- if {[string compare $state(value) parts]} {
+ if {$state(value) ne "parts" } {
puts $channel ""
if {$state(canonicalP)} {
- if {![string compare [set encoding $state(encoding)] ""]} {
+ if {[set encoding $state(encoding)] eq "" } {
set encoding [encoding $token]
}
- if {[string compare $encoding ""]} {
+ if {$encoding ne "" } {
puts $channel "Content-Transfer-Encoding: $encoding"
}
switch -- $encoding {
@@ -1578,8 +1578,8 @@
}
}
}
- } elseif {([string match multipart/* $state(content)]) \
- && (![string compare $boundary ""])} {
+ } elseif {([string match "multipart/*" $state(content)]) \
+ && ($boundary eq "" )} {
# we're doing everything in one pass...
set key [clock seconds]$token[info hostname][array get state]
set seqno 8
@@ -1634,7 +1634,7 @@
if {$size > 0} {
set size [expr {$size - [string length $X]}]
}
- if {[string compare $converter ""]} {
+ if {$converter ne "" } {
puts $channel [$converter -mode encode -- $X]
} else {
puts $channel $X
@@ -1688,7 +1688,7 @@
puts $channel ""
- if {[string compare $converter ""]} {
+ if {$converter ne "" } {
puts $channel [$converter -mode encode -- $state(string)]
} else {
puts $channel $state(string)
@@ -1701,7 +1701,7 @@
flush $channel
- if {[string compare $converter ""]} {
+ if {$converter ne "" } {
unstack $channel
}
if {[info exists state(error)]} {
@@ -1767,7 +1767,7 @@
array set header $state(header)
set result ""
- if {[string compare $state(version) ""]} {
+ if {$state(version) ne "" } {
append result "MIME-Version: $state(version)\r\n"
}
foreach lower $state(lowerL) mixed $state(mixedL) {
@@ -1783,7 +1783,7 @@
append result "Content-Type: $state(content)"
set boundary ""
foreach {k v} $state(params) {
- if {![string compare $k boundary]} {
+ if {$k eq "boundary" } {
set boundary $v
}
@@ -1792,14 +1792,14 @@
set converter ""
set encoding ""
- if {[string compare $state(value) parts]} {
+ if {$state(value) ne "parts" } {
append result \r\n
if {$state(canonicalP)} {
- if {![string compare [set encoding $state(encoding)] ""]} {
+ if {[set encoding $state(encoding)] eq "" } {
set encoding [encoding $token]
}
- if {[string compare $encoding ""]} {
+ if {$encoding ne "" } {
append result "Content-Transfer-Encoding: $encoding\r\n"
}
switch -- $encoding {
@@ -1817,8 +1817,8 @@
}
}
}
- } elseif {([string match multipart/* $state(content)]) \
- && (![string compare $boundary ""])} {
+ } elseif {([string match "multipart/*" $state(content)]) \
+ && ($boundary eq "" )} {
# we're doing everything in one pass...
set key [clock seconds]$token[info hostname][array get state]
set seqno 8
@@ -1872,7 +1872,7 @@
if {$size > 0} {
set size [expr {$size - [string length $X]}]
}
- if {[string compare $converter ""]} {
+ if {$converter ne "" } {
append result "[$converter -mode encode -- $X]\r\n"
} else {
append result "$X\r\n"
@@ -1920,7 +1920,7 @@
append result "\r\n"
- if {[string compare $converter ""]} {
+ if {$converter ne "" } {
append result "[$converter -mode encode -- $state(string)]\r\n"
} else {
append result "$state(string)\r\n"
@@ -2018,9 +2018,9 @@
text/* {
if {!$asciiP} {
foreach {k v} $state(params) {
- if {![string compare $k charset]} {
+ if {$k eq "charset" } {
set v [string tolower $v]
- if {([string compare $v us-ascii]) \
+ if {([string compare $v "us-ascii"]) \
&& (![string match {iso-8859-[1-8]} $v])} {
return base64
}
@@ -2117,7 +2117,7 @@
variable $token
upvar 0 $token state
- if {[string compare $error ""]} {
+ if {$error ne "" } {
set state(error) $error
}
set state(doneP) 1
@@ -2401,16 +2401,16 @@
set result ""
while {[addr_next $token]} {
- if {[string compare [set tail $state(domain)] ""]} {
+ if {[set tail $state(domain)] ne "" } {
set tail @$state(domain)
} else {
set tail @[info hostname]
}
- if {[string compare [set address $state(local)] ""]} {
+ if {[set address $state(local)] ne "" } {
append address $tail
}
- if {[string compare $state(phrase) ""]} {
+ if {$state(phrase) ne "" } {
set state(phrase) [string trim $state(phrase) "\""]
foreach t $state(tokenL) {
if {[string first $t $state(phrase)] >= 0} {
@@ -2424,8 +2424,8 @@
set proper $address
}
- if {![string compare [set friendly $state(phrase)] ""]} {
- if {[string compare [set note $state(comment)] ""]} {
+ if {[set friendly $state(phrase)] eq "" } {
+ if {[set note $state(comment)] ne "" } {
if {[string first "(" $note] == 0} {
set note [string trimleft [string range $note 1 end]]
}
@@ -2436,7 +2436,7 @@
set friendly $note
}
- if {(![string compare $friendly ""]) \
+ if {($friendly eq "" ) \
&& ([string compare [set mbox $state(local)] ""])} {
set mbox [string trim $mbox "\""]
@@ -2454,7 +2454,7 @@
set friendly "$g $friendly"
}
- if {![string compare $friendly ""]} {
+ if {$friendly eq "" } {
set friendly $mbox
}
}
@@ -2657,7 +2657,7 @@
-
LX_END {
set state(memberP) $state(glevel)
- if {(![string compare $state(lastC) LX_SEMICOLON]) \
+ if {($state(lastC) eq "LX_SEMICOLON" ) \
&& ([incr state(glevel) -1] < 0)} {
return -code 7 "extraneous semi-colon"
}
@@ -2692,7 +2692,7 @@
upvar 0 $token state
set lookahead $state(input)
- if {![string compare [parselexeme $token] LX_ATSIGN]} {
+ if {[parselexeme $token] eq "LX_ATSIGN" } {
mime::addr_route $token
} else {
set state(input) $lookahead
@@ -2721,7 +2721,7 @@
}
}
- if {($checkP) && ([string compare $state(lastC) LX_RBRACKET])} {
+ if {($checkP) && ([string compare $state(lastC) "LX_RBRACKET"])} {
return -code 7 [format "expecting right-bracket (found %s)" \
$state(buffer)]
}
@@ -3089,7 +3089,7 @@
# specified in 'value'.
proc ::mime::parsedatetime {value property} {
- if {![string compare $value -now]} {
+ if {$value eq "-now" } {
set clock [clock seconds]
} else {
set clock [clock scan $value]
@@ -3140,7 +3140,7 @@
}
rclock {
- if {![string compare $value -now]} {
+ if {$value eq "-now" } {
return 0
} else {
return [expr {[clock seconds]-$clock}]
@@ -3176,7 +3176,7 @@
set value [string range $value [expr {$x+1}] end]
switch -- [set s [string index $value 0]] {
+ - - {
- if {![string compare $s +]} {
+ if {$s eq "+" } {
set s ""
}
set value [string trim [string range $value 1 end]]
@@ -3261,15 +3261,15 @@
set state(input) [string trimleft $state(input)]
set state(buffer) ""
- if {![string compare $state(input) ""]} {
+ if {$state(input) eq "" } {
set state(buffer) end-of-input
return [set state(lastC) LX_END]
}
set c [string index $state(input) 0]
set state(input) [string range $state(input) 1 end]
- if {![string compare $c "("]} {
+ if {$c eq "(" } {
set noteP 0
set quoteP 0
@@ -3341,7 +3341,7 @@
}
}
- if {![string compare $c "\["]} {
+ if {$c eq "\[" } {
set quoteP 0
while {1} {
@@ -3462,11 +3462,11 @@
error "unknown charset '$charset'"
}
- if {$encodings($charset) == ""} {
+ if {$encodings($charset) eq ""} {
error "invalid charset '$charset'"
}
- if {$method != "base64" && $method != "quoted-printable"} {
+ if {$method != "base64" && $method ne "quoted-printable"} {
error "unknown method '$method', must be base64 or quoted-printable"
}
@@ -3509,7 +3509,7 @@
}
set enc [reversemapencoding $charset]
- if {[string equal "" $enc]} {
+ if {$enc eq ""} {
error "unknown charset '$charset'"
}
Index: openacs-4/packages/acs-tcl/tcl/navigation-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/navigation-procs.tcl,v
diff -u -r1.20 -r1.21
--- openacs-4/packages/acs-tcl/tcl/navigation-procs.tcl 8 Feb 2005 01:22:52 -0000 1.20
+++ openacs-4/packages/acs-tcl/tcl/navigation-procs.tcl 10 Jan 2007 21:22:12 -0000 1.21
@@ -32,7 +32,7 @@
@see ad_context_bar
} {
set out {}
- foreach element [lrange $context 0 [expr [llength $context] - 2]] {
+ foreach element [lrange $context 0 [expr {[llength $context] - 2}]] {
append out "<a href=\"[lindex $element 0]\">[lindex $element 1]</a>$separator"
}
append out [lindex $context end]
@@ -54,21 +54,21 @@
} {
set context [list]
- while { ![empty_string_p $node_id] } {
+ while { $node_id ne "" } {
array set node [site_node::get -node_id $node_id]
# JCD: Provide something for the name if the instance name is
# absent. name is the tail bit of the url which seems like a
# reasonable thing to display.
- if {[empty_string_p $node(instance_name)]
+ if {$node(instance_name) eq ""
&& [info exists node(name)]} {
set node(instance_name) $node(name)
}
set context [concat [list [list $node(url) [ad_quotehtml $node(instance_name)]]] $context]
# We have the break here, so that 'from_node' itself is included
- if { [string equal $node_id $from_node] } {
+ if {$node_id eq $from_node} {
break
}
@@ -151,7 +151,7 @@
set context [ad_context_node_list -from_node $from_node $node_id]
- if { [string match admin/* [ad_conn extra_url]] } {
+ if { [string match "admin/*" [ad_conn extra_url]] } {
lappend context [list "[ad_conn package_url]admin/" \
"Administration"]
}
@@ -160,7 +160,7 @@
# fix last element to just be literal string
set context [lreplace $context end end [lindex [lindex $context end] 1]]
} else {
- if ![string match "\{*" $args] {
+ if {![string match "\{*" $args]} {
# args is not a list, transform it into one.
set args [list $args]
}
@@ -245,7 +245,7 @@
set return_list [list]
foreach value $values {
- if { [string compare $default $value] == 0 } {
+ if { $default eq $value } {
lappend return_list "<strong>[lindex $items $count]</strong>"
} else {
lappend return_list "<a href=\"[lindex $links $count]\">[lindex $items $count]</a>"
@@ -350,9 +350,9 @@
# if the url matches the url you would redirect to, as determined
# either by highlight_url, or if highlight_url is not set,
# the current url then select it
- if {$highlight_url != "" && $highlight_url == [lindex $urls $counter]} {
+ if {$highlight_url ne "" && $highlight_url == [lindex $urls $counter]} {
append return_string "<OPTION VALUE=\"[lindex $urls $counter]\" selected>$item"
- } elseif {$highlight_url == "" && [string match *$url_stub* [lindex $urls $counter]]} {
+ } elseif {$highlight_url eq "" && [string match *$url_stub* [lindex $urls $counter]]} {
append return_string "<OPTION VALUE=\"[lindex $urls $counter]\" selected>$item"
} else {
append return_string "<OPTION VALUE=\"[lindex $urls $counter]\">$item"
Index: openacs-4/packages/acs-tcl/tcl/openacs-kernel-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/Attic/openacs-kernel-procs.tcl,v
diff -u -r1.8 -r1.9
--- openacs-4/packages/acs-tcl/tcl/openacs-kernel-procs.tcl 19 Feb 2006 19:33:27 -0000 1.8
+++ openacs-4/packages/acs-tcl/tcl/openacs-kernel-procs.tcl 10 Jan 2007 21:22:12 -0000 1.9
@@ -25,7 +25,7 @@
set csv_stream [open $file r]
# Check if there are headers
- if {![empty_string_p $override_headers]} {
+ if {$override_headers ne ""} {
set headers $override_headers
} else {
if {!$header_line} {
@@ -61,7 +61,7 @@
}
# Add in the constants
- if {![empty_string_p $constants]} {
+ if {$constants ne ""} {
# This modifies extra_vars, without touching constants
ns_set merge $constants $extra_vars
}
@@ -97,7 +97,7 @@
set csv_stream [open $file r]
# Check if there are headers
- if {![empty_string_p $override_headers]} {
+ if {$override_headers ne ""} {
set headers $override_headers
} else {
if {!$header_line} {
Index: openacs-4/packages/acs-tcl/tcl/parameter-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/parameter-procs.tcl,v
diff -u -r1.15 -r1.16
--- openacs-4/packages/acs-tcl/tcl/parameter-procs.tcl 30 Mar 2005 00:36:12 -0000 1.15
+++ openacs-4/packages/acs-tcl/tcl/parameter-procs.tcl 10 Jan 2007 21:22:12 -0000 1.16
@@ -38,7 +38,7 @@
@param parameter which parameter's value to set
@param value what value to set said parameter to
} {
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
set package_id [ad_requested_object_id]
}
@@ -66,13 +66,13 @@
@return The string trimmed (leading and trailing spaces removed) parameter value
} {
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
set package_id [ad_requested_object_id]
}
set package_key ""
set value ""
- if {![empty_string_p $package_id]} {
+ if {$package_id ne ""} {
# This can fail at server startup--OpenACS calls parameter::get to
# get the size of the util_memoize cache so it can setup the cache.
# apm_package_key_from_id needs that cache, but on server start
@@ -86,16 +86,16 @@
# If I convert the package_id to a package_key, is there a parameter by this
# name in the parameter file? If so, it takes precedence.
# 1. use the parameter file
- if {![empty_string_p $package_key]} {
+ if {$package_key ne ""} {
set value [ad_parameter_from_file $parameter $package_key]
}
# 2. check the parameter cache
- if {[empty_string_p $value]} {
+ if {$value eq ""} {
set value [ad_parameter_cache $package_id $parameter]
}
# 3. use the default value
- if {[empty_string_p $value]} {
+ if {$value eq ""} {
set value $default
}
@@ -164,7 +164,7 @@
# 2. try to get a package_id for this package_key and use the standard
# parameter::get function to get the value
- if {[empty_string_p $value]} {
+ if {$value eq ""} {
with_catch errmsg {
set value [parameter::get \
-localize=$localize_p \
Index: openacs-4/packages/acs-tcl/tcl/request-processor-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/request-processor-init.tcl,v
diff -u -r1.11 -r1.12
--- openacs-4/packages/acs-tcl/tcl/request-processor-init.tcl 3 Mar 2005 21:06:36 -0000 1.11
+++ openacs-4/packages/acs-tcl/tcl/request-processor-init.tcl 10 Jan 2007 21:22:12 -0000 1.12
@@ -47,7 +47,7 @@
ns_unregister_proc POST /*.tcl
set listings [ns_config "ns/server/[ns_info server]" "directorylisting" "none"]
-if { [string equal $listings "fancy"] || [string equal $listings "simple"] } {
+if { $listings eq "fancy" || $listings eq "simple" } {
nsv_set rp_directory_listing_p . 1
} else {
nsv_set rp_directory_listing_p . 0
@@ -90,7 +90,7 @@
set arg_count [llength [info args $proc]]
}
- if { $debug == "t" } {
+ if { $debug eq "t" } {
set debug_p 1
} else {
set debug_p 0
@@ -116,7 +116,7 @@
foreach proc_info $procs {
util_unlist $proc_info method path proc arg debug noinherit description script
- if { $noinherit == "t" } {
+ if { $noinherit eq "t" } {
set noinherit_switch "-noinherit"
} else {
set noinherit_switch ""
@@ -132,7 +132,7 @@
set arg_count [llength [info args $proc]]
}
- if { $debug == "t" } {
+ if { $debug eq "t" } {
set debug_p 1
} else {
set debug_p 0
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 -r1.85 -r1.86
--- openacs-4/packages/acs-tcl/tcl/request-processor-procs.tcl 4 Jun 2006 00:45:47 -0000 1.85
+++ openacs-4/packages/acs-tcl/tcl/request-processor-procs.tcl 10 Jan 2007 21:22:12 -0000 1.86
@@ -54,7 +54,7 @@
}
if { [string is false $absolute_path_p] } {
- if { [string index $path 0] != "/" } {
+ if { [string index $path 0] ne "/" } {
# it's a relative path, prepend the current location
set path "[file dirname [ad_conn file]]/$path"
} else {
@@ -204,7 +204,7 @@
sitewide (not subsite-by-subsite basis).
} {
- if { [string equal $method "*"] } {
+ if {$method eq "*"} {
# Shortcut to allow registering filter for all methods. Just
# call ad_register_proc again, with each of the three methods.
foreach method { GET POST HEAD } {
@@ -257,7 +257,7 @@
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 { [string compare $result "filter_ok"] && [string compare $result "filter_break"] && \
+ } elseif {$result ne "filter_ok" && $result ne "filter_break" && \
[string compare $result "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]
@@ -273,7 +273,7 @@
# JCD: Why was this here? the rp_finish_serving_page is called inside the
# handlers and this handles trace filters
-# if { [string compare $result "filter_return"] } {
+# if {$result ne "filter_return" } {
# rp_finish_serving_page
# }
@@ -322,7 +322,7 @@
ad_proc -private rp_finish_serving_page {} {
global doc_properties
if { [info exists doc_properties(body)] } {
- rp_debug "Returning page:[info level [expr [info level] - 1]]: [ad_quotehtml [string range $doc_properties(body) 0 100]]"
+ rp_debug "Returning page:[info level [expr {[info level] - 1}]]: [ad_quotehtml [string range $doc_properties(body) 0 100]]"
doc_return 200 text/html $doc_properties(body)
}
}
@@ -366,7 +366,7 @@
sitewide (not subsite-by-subsite basis).
} {
- if { [string equal $method "*"] } {
+ if {$method eq "*"} {
# Shortcut to allow registering filter for all methods.
foreach method { GET POST HEAD } {
ad_register_filter -debug $debug -priority $priority -critical $critical $kind $method $path $proc $arg
@@ -421,7 +421,7 @@
# Build the stat array containing information about the file.
file stat $file stat
- set size [expr $stat(size) / 1000 + 1]K
+ set size [expr {$stat(size) / 1000 + 1}]K
set mtime $stat(mtime)
set time [clock format $mtime -format "%d-%h-%Y %H:%M"]
@@ -525,7 +525,7 @@
set url [ad_conn url]
# 2. handle special case: if the root is a prefix of the URL,
# remove this prefix from the URL, and redirect.
- if { ![empty_string_p $root] } {
+ if { $root ne "" } {
if { [regexp "^${root}(.*)$" $url match url] } {
if { [regexp {^GET [^\?]*\?(.*) HTTP} [ns_conn request] match vars] } {
@@ -560,14 +560,14 @@
# should not redirect since we got a hostname we know about.
set acs_kernel_id [util_memoize ad_acs_kernel_id]
- if { [empty_string_p $root]
+ if { $root eq ""
&& [ad_parameter -package_id $acs_kernel_id ForceHostP request-processor 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
- if { $host_header != "" && [string compare $host_no_port $desired_host_no_port] } {
+ if { $host_header ne "" && $host_no_port ne $desired_host_no_port } {
set query [ns_getform]
- if { $query != "" } {
+ if { $query ne "" } {
set query "?[export_entire_form_as_url_vars]"
}
ad_returnredirect "[ns_conn location][ns_conn url]$query"
@@ -582,7 +582,7 @@
# trailing element except in the case where urlc is 0 and urlv the empty list.
if { [lindex [ad_conn urlv] end] == "" } {
- ad_conn -set urlc [expr [ad_conn urlc] - 1]
+ ad_conn -set urlc [expr {[ad_conn urlc] - 1}]
ad_conn -set urlv [lrange [ad_conn urlv] 0 [expr {[llength [ad_conn urlv]] - 2}] ]
}
@@ -592,7 +592,7 @@
# log and do nothing
rp_debug "error within rp_filter [ns_conn method] [ns_conn url] [ns_conn query]. $errmsg"
} else {
- if { [string equal $node(url) "[ad_conn url]/"] } {
+ if {$node(url) eq "[ad_conn url]/"} {
ad_returnredirect $node(url)
rp_debug "rp_filter: returnredirect $node(url)"
rp_debug "rp_filter: return filter_return"
@@ -699,8 +699,8 @@
ds_add rp [list debug $string $clicks $clicks]
}
if { [ad_parameter -package_id [ad_acs_kernel_id] LogDebugP request-processor 0]
- || [string equal $debug t]
- || [string equal $debug 1]
+ || $debug eq "t"
+ || $debug eq "1"
} {
global ad_conn
if { [info exists ad_conn(start_clicks)] } {
@@ -769,17 +769,17 @@
ad_proc -private rp_path_prefixes {path} {
Returns all the prefixes of a path ordered from most to least specific.
} {
- if {[string index $path 0] != "/"} {
+ if {[string index $path 0] ne "/"} {
set path "/$path"
}
set path [string trimright $path /]
- if { [string length $path] == 0 } {
+ if { $path eq "" } {
return "/"
}
set components [split $path "/"]
set prefixes [list]
- for {set i [expr [llength $components] -1]} {$i > 0} {incr i -1} {
+ for {set i [expr {[llength $components] -1}]} {$i > 0} {incr i -1} {
lappend prefixes "[join [lrange $components 0 $i] "/"]/"
lappend prefixes "[join [lrange $components 0 $i] "/"]"
}
@@ -882,15 +882,15 @@
# Now visit the candidates columnwise: from most specific to least
foreach cand0 [lindex $candidates 0] cand1 [lindex $candidates 1] {
foreach candidate [list $cand0 $cand1] {
- if { [empty_string_p $candidate] } {
+ if { $candidate eq "" } {
continue
}
set root [lindex $candidate 0]; # fewer instructions than util_unlist
set path [lindex $candidate 1]
set prefix [lindex $candidate 2]
ad_try {
ad_conn -set path_info \
- [string range $path [expr [string length $prefix] - 1] end]
+ [string range $path [expr {[string length $prefix] - 1}] end]
rp_serve_abstract_file -noredirect -nodirectory \
-extension_pattern ".vuh" "$root$prefix"
set tcl_url2file([ad_conn url]) [ad_conn file]
@@ -914,7 +914,7 @@
ns_returnnotfound
} errmsg]] } {
if {$code == 1} {
- if {![string equal [ns_conn query] ""]} {
+ if {[ns_conn query] ne "" } {
set q ?
} else {
set q ""
@@ -944,7 +944,7 @@
@see rp_internal_redirect
} {
- if { [string equal [string index $path end] "/"] } {
+ if {[string index $path end] eq "/"} {
if { [file isdirectory $path] } {
# The path specified was a directory; return its index file.
@@ -985,7 +985,7 @@
# URL but with a trailing slash.
set url "[ad_conn url]/"
- if { [ad_conn query] != "" } {
+ if { [ad_conn query] ne "" } {
append url "?[ad_conn query]"
}
@@ -1133,7 +1133,7 @@
global ad_conn
set flag [lindex $args 0]
- if {[string index $flag 0] != "-"} {
+ if {[string index $flag 0] ne "-"} {
set var $flag
set flag "-get"
} else {
@@ -1302,7 +1302,7 @@
doc_serve_document
} else {
set content_type [ns_set iget [ad_conn outputheaders] "content-type"]
- if { $content_type == "" } {
+ if { $content_type eq "" } {
set content_type "text/html"
}
doc_return 200 $content_type $adp
@@ -1449,10 +1449,10 @@
# Other hostnames map to subsites.
set node_id [util_memoize [list rp_lookup_node_from_host $host]]
- if { ![empty_string_p $node_id] } {
+ if { $node_id ne "" } {
set url [site_node::get_url -node_id $node_id]
- return [string range $url 0 [expr [string length $url]-2]]
+ return [string range $url 0 [expr {[string length $url]-2}]]
} else {
# Hack to provide a useful default
return ""
Index: openacs-4/packages/acs-tcl/tcl/rollout-email-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/Attic/rollout-email-procs.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-tcl/tcl/rollout-email-procs.tcl 13 Jan 2005 13:55:55 -0000 1.5
+++ openacs-4/packages/acs-tcl/tcl/rollout-email-procs.tcl 10 Jan 2007 21:22:12 -0000 1.6
@@ -81,7 +81,7 @@
} {
set targets [ns_config ns/server/[ns_info server]/acs/acs-rollout-support EmailRedirectTo]
- if { ![string equal $targets ""] } {
+ if { $targets ne "" } {
set body "The following email would have been sent from \"[ad_parameter SystemName]\", but
was instead redirected to you.
Index: openacs-4/packages/acs-tcl/tcl/security-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/security-init.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-tcl/tcl/security-init.tcl 1 Nov 2003 08:45:37 -0000 1.3
+++ openacs-4/packages/acs-tcl/tcl/security-init.tcl 10 Jan 2007 21:22:12 -0000 1.4
@@ -32,7 +32,7 @@
"
proc sec_session_renew {} "
- return \"[expr [sec_session_timeout] - [ad_parameter -package_id [ad_acs_kernel_id] SessionRenew security 300]]\"
+ return \"[expr {[sec_session_timeout] - [ad_parameter -package_id [ad_acs_kernel_id] SessionRenew security 300]}]\"
"
proc sec_login_timeout {} "
Index: openacs-4/packages/acs-tcl/tcl/security-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/security-procs.tcl,v
diff -u -r1.40 -r1.41
--- openacs-4/packages/acs-tcl/tcl/security-procs.tcl 15 Dec 2006 00:02:00 -0000 1.40
+++ openacs-4/packages/acs-tcl/tcl/security-procs.tcl 10 Jan 2007 21:22:12 -0000 1.41
@@ -118,10 +118,10 @@
ns_log Debug "Security: Insecure session OK: session_id = $session_id, untrusted_user_id = $untrusted_user_id, auth_level = $auth_level, user_id = $user_id"
# We're okay, insofar as the insecure session, check if it's also secure
- if { [string equal $auth_level "ok"] && [security::secure_conn_p] } {
+ if { $auth_level eq "ok" && [security::secure_conn_p] } {
catch {
set sec_token [split [ad_get_signed_cookie "ad_secure_token"] {,}]
- if { [string equal [lindex $sec_token 0] $session_id] } {
+ if {[lindex $sec_token 0] eq $session_id} {
set auth_level secure
}
}
@@ -173,7 +173,7 @@
set login_list [split [ad_get_signed_cookie "ad_user_login_secure"] ","]
}
}
- if { [empty_string_p $login_list] } {
+ if { $login_list eq "" } {
set login_list [split [ad_get_signed_cookie "ad_user_login"] ","]
}
@@ -187,7 +187,7 @@
# First, check expiration
if { [sec_login_timeout] == 0 || [ns_time] - $login_expr < [sec_login_timeout] } {
# Then check auth_token
- if { [string equal $auth_token [sec_get_user_auth_token $untrusted_user_id]] } {
+ if {$auth_token eq [sec_get_user_auth_token $untrusted_user_id]} {
# Are we secure?
if { [security::secure_conn_p] } {
# We retrieved the secure login cookie over HTTPS, we're secure
@@ -201,7 +201,7 @@
# Check account status
set account_status [auth::get_local_account_status -user_id $untrusted_user_id]
- if { [string equal $account_status "no_account"] } {
+ if {$account_status eq "no_account"} {
set untrusted_user_id 0
set auth_level none
set account_status "closed"
@@ -270,7 +270,7 @@
} -default {}]
db_release_unused_handles
- if { [empty_string_p $auth_token] } {
+ if { $auth_token eq "" } {
ns_log Debug "Security: User $user_id does not have any auth_token, creating a new one."
set auth_token [sec_change_user_auth_token $user_id]
}
@@ -319,7 +319,7 @@
set salt [string trim $salt]
- if { [string compare $password [ns_sha1 "$password_from_form$salt"]] } {
+ if {$password ne [ns_sha1 "$password_from_form$salt"] } {
return 0
}
@@ -335,7 +335,7 @@
# In case someone wants to change the salt from now on, you can do
# this and still support old users by changing the salt below.
- if { [empty_string_p $user_id] } {
+ if { $user_id eq "" } {
error "No user_id supplied"
}
@@ -360,7 +360,7 @@
set session_id [ad_conn session_id]
# figure out the session id, if we don't already have it
- if { [empty_string_p $session_id]} {
+ if { $session_id eq ""} {
ns_log debug "OACS= empty session_id"
@@ -401,7 +401,7 @@
set user_id 0
# If both auth_level and account_status are 'ok' or better, we have a solid user_id
- if { ([string equal $auth_level "ok"] || [string equal $auth_level "secure"]) && [string equal $account_status "ok"] } {
+ if { ($auth_level eq "ok" || $auth_level eq "secure") && $account_status eq "ok" } {
set user_id $new_user_id
}
@@ -418,7 +418,7 @@
ns_log debug "OACS= done generating session id cookie"
- if { [string equal $auth_level "secure"] && [security::secure_conn_p] && $new_user_id != 0 } {
+ if { $auth_level eq "secure" && [security::secure_conn_p] && $new_user_id != 0 } {
# this is a secure session, so the browser needs
# a cookie marking it as such
sec_generate_secure_token_cookie
@@ -451,8 +451,8 @@
set account_status [ad_conn account_status]
set login_level 0
- if { [string equal $auth_level "ok"] || [string equal $auth_level "secure"] } {
- if { [string equal $account_status "ok"] } {
+ if { $auth_level eq "ok" || $auth_level eq "secure" } {
+ if {$account_status eq "ok"} {
set login_level 1
} else {
set login_level 2
@@ -491,7 +491,7 @@
# Thread just spawned or we exceeded preallocated count.
set tcl_current_sequence_id [db_nextval sec_id_seq]
db_release_unused_handles
- set tcl_max_value [expr $tcl_current_sequence_id + 100]
+ set tcl_max_value [expr {$tcl_current_sequence_id + 100}]
}
set session_id $tcl_current_sequence_id
@@ -509,7 +509,7 @@
set url [ad_conn url]
if { [string match "*register/*" $url] || [string match "/index*" $url] || \
[string match "/index*" $url] || \
- [string match "/" $url] || \
+ "/" eq $url || \
[string match "*password-update*" $url] } {
return 1
}
@@ -623,10 +623,10 @@
append url "register/logout"
- if { $return_p && [empty_string_p $return_url] } {
+ if { $return_p && $return_url eq "" } {
set return_url [ad_return_url]
}
- if { ![empty_string_p $return_url] } {
+ if { $return_url ne "" } {
set url [export_vars -base $url { return_url }]
}
@@ -645,7 +645,7 @@
unregistered, except the site index page and stuff underneath
[subsite]/register. Use permissions on the site node map to control access.
} {
- if {![string match "/index.tcl" [ad_conn url]] && ![string match "/" [ad_conn url]] && ![string match "*/register/*" [ad_conn url]] && ![string match "*/SYSTEM/*" [ad_conn url]] && ![string match "*/user_please_login.tcl" [ad_conn url]]} {
+ if {"/index.tcl" ne [ad_conn url] && "/" ne [ad_conn url] && ![string match "*/register/*" [ad_conn url]] && ![string match "*/SYSTEM/*" [ad_conn url]] && ![string match "*/user_please_login.tcl" [ad_conn url]]} {
# not one of the magic acceptable URLs
set user_id [ad_conn user_id]
if {$user_id == 0} {
@@ -695,8 +695,8 @@
@param value the value to be signed.
} {
- if { [empty_string_p $secret] } {
- if {[empty_string_p $token_id]} {
+ if { $secret eq "" } {
+ if {$token_id eq ""} {
# pick a random token_id
set token_id [sec_get_random_cached_token_id]
}
@@ -708,10 +708,10 @@
ns_log Debug "Security: Getting token_id $token_id, value $secret_token"
- if { $max_age == "" } {
+ if { $max_age eq "" } {
set expire_time 0
} else {
- set expire_time [expr $max_age + [ns_time]]
+ set expire_time [expr {$max_age + [ns_time]}]
}
set hash [ns_sha1 "$value$token_id$expire_time$secret_token"]
@@ -776,8 +776,8 @@
} {
- if { [empty_string_p $secret] } {
- if { [empty_string_p $token_id] } {
+ if { $secret eq "" } {
+ if { $token_id eq "" } {
ns_log Debug "__ad_verify_signature: Neither secret, nor token_id supplied"
return 0
}
@@ -797,7 +797,7 @@
set hash_ok_p 0
set expiration_ok_p 0
- if { [string equal $computed_hash $hash] } {
+ if {$computed_hash eq $hash} {
ns_log Debug "__ad_verify_signature: Hash matches - Hash check OK"
set hash_ok_p 1
} else {
@@ -807,7 +807,7 @@
set org_computed_hash $computed_hash
set computed_hash [ns_sha1 "$value$token_id$expire_time$secret_token"]
- if { [string equal $computed_hash $hash] } {
+ if {$computed_hash eq $hash} {
ns_log Debug "__ad_verify_signature: Hash matches after correcting for IE bug - Hash check OK"
set hash_ok_p 1
} else {
@@ -826,7 +826,7 @@
}
# Return validation result
- return [expr $hash_ok_p && $expiration_ok_p]
+ return [expr {$hash_ok_p && $expiration_ok_p}]
}
@@ -842,13 +842,13 @@
} {
- if { $include_set_cookies == "t" } {
+ if { $include_set_cookies eq "t" } {
set cookie_value [ns_urldecode [ad_get_cookie $name]]
} else {
set cookie_value [ns_urldecode [ad_get_cookie -include_set_cookies f $name]]
}
- if { [empty_string_p $cookie_value] } {
+ if { $cookie_value eq "" } {
error "Cookie does not exist."
}
@@ -880,13 +880,13 @@
} {
- if { $include_set_cookies == "t" } {
+ if { $include_set_cookies eq "t" } {
set cookie_value [ns_urldecode [ad_get_cookie $name]]
} else {
set cookie_value [ns_urldecode [ad_get_cookie -include_set_cookies f $name]]
}
- if { [empty_string_p $cookie_value] } {
+ if { $cookie_value eq "" } {
error "Cookie does not exist."
}
@@ -938,10 +938,10 @@
url-encoded.
} {
- if { [empty_string_p $signature_max_age] } {
- if { $max_age == "inf" } {
+ if { $signature_max_age eq "" } {
+ if { $max_age eq "inf" } {
set signature_max_age ""
- } elseif { $max_age != "" } {
+ } elseif { $max_age ne "" } {
set signature_max_age $max_age
} else {
# this means we want a session level cookie,
@@ -1138,12 +1138,12 @@
@param session_id controls which session is used
} {
- if { [empty_string_p $session_id] } {
+ if { $session_id eq "" } {
set id [ad_conn session_id]
# if session_id is still undefined in the connection then we
# should just return the default
- if { [empty_string_p $id] } {
+ if { $id eq "" } {
return $default
}
} else {
@@ -1152,22 +1152,22 @@
set cmd [list sec_lookup_property $id $module $name]
- if { $cache_only == "t" && ![util_memoize_cached_p $cmd] } {
+ if { $cache_only eq "t" && ![util_memoize_cached_p $cmd] } {
return ""
}
- if { $cache != "t" } {
+ if { $cache ne "t" } {
util_memoize_flush $cmd
}
set property [util_memoize $cmd [sec_session_timeout]]
- if { $property == "" } {
+ if { $property eq "" } {
return $default
}
set value [lindex $property 0]
set secure_p [lindex $property 1]
- if { $secure_p != "f" && ![security::secure_conn_p] } {
+ if { $secure_p ne "f" && ![security::secure_conn_p] } {
return ""
}
@@ -1196,15 +1196,15 @@
} {
- if { $secure != "f" && ![security::secure_conn_p] } {
+ if { $secure ne "f" && ![security::secure_conn_p] } {
error "Unable to set secure property in insecure or invalid session"
}
- if { [empty_string_p $session_id] } {
+ if { $session_id eq "" } {
set session_id [ad_conn session_id]
}
- if { $persistent == "t" } {
+ if { $persistent eq "t" } {
# Write to database - either defer, or write immediately. First delete the old
# value if any; then insert the new one.
@@ -1229,7 +1229,7 @@
db_dml prop_insert_dml ""
- if { $clob == "t" && ![empty_string_p $clob_update_dml] } {
+ if { $clob eq "t" && $clob_update_dml ne "" } {
db_dml prop_update_dml_clob "" -clobs [list $value]
} else {
db_dml prop_update_dml ""
@@ -1500,7 +1500,7 @@
# Add port number if non-standard
set https_port [get_https_port]
- if { ![string equal $https_port 443] } {
+ if { $https_port ne "443" } {
set secure_location ${secure_location}:$https_port
}
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 -r1.3 -r1.4
--- openacs-4/packages/acs-tcl/tcl/server-cluster-procs.tcl 4 Jun 2006 00:45:47 -0000 1.3
+++ openacs-4/packages/acs-tcl/tcl/server-cluster-procs.tcl 10 Jan 2007 21:22:12 -0000 1.4
@@ -66,7 +66,7 @@
{ -timeout 5 }
url
} { Schedules an HTTP GET request to be issued immediately to all peer hosts (using ad_schedule_proc -once t -thread f -debug t 0). } {
- if { ![string match /* $url] } {
+ if { ![string match "/*" $url] } {
set url "/$url"
}
foreach host [server_cluster_peer_hosts] {
@@ -86,7 +86,7 @@
load balancer).
} {
set canonical_server [ad_parameter -package_id [ad_acs_kernel_id] CanonicalServer server-cluster]
- if { [empty_string_p $canonical_server] } {
+ if { $canonical_server eq "" } {
ns_log Error "Your configuration is not correct for server clustering. Please ensure that you have the CanonicalServer parameter set correctly."
return 1
}
Index: openacs-4/packages/acs-tcl/tcl/site-node-apm-integration-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/site-node-apm-integration-procs.tcl,v
diff -u -r1.11 -r1.12
--- openacs-4/packages/acs-tcl/tcl/site-node-apm-integration-procs.tcl 4 Jun 2006 00:45:47 -0000 1.11
+++ openacs-4/packages/acs-tcl/tcl/site-node-apm-integration-procs.tcl 10 Jan 2007 21:22:12 -0000 1.12
@@ -41,7 +41,7 @@
get the package_id of package_key that is mounted directly under
package_id. returns empty string if not found.
} {
- if {[empty_string_p $package_id]} {
+ if {$package_id eq ""} {
if {[ad_conn isconnected]} {
set package_id [ad_conn package_id]
} else {
@@ -64,7 +64,7 @@
-package_key $package_key
]
- if {[empty_string_p $child_package_id]} {
+ if {$child_package_id eq ""} {
return 0
} else {
return 1
Index: openacs-4/packages/acs-tcl/tcl/site-node-object-map-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/site-node-object-map-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-tcl/tcl/site-node-object-map-procs.tcl 27 Feb 2005 22:45:39 -0000 1.3
+++ openacs-4/packages/acs-tcl/tcl/site-node-object-map-procs.tcl 10 Jan 2007 21:22:12 -0000 1.4
@@ -42,7 +42,7 @@
} {
set node_id [site_node_object_map::get_node_id -object_id $object_id]
- if {[empty_string_p $node_id]} {
+ if {$node_id eq ""} {
return {}
}
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 -r1.67 -r1.68
--- openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl 24 Mar 2005 16:26:35 -0000 1.67
+++ openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl 10 Jan 2007 21:22:12 -0000 1.68
@@ -49,7 +49,7 @@
with_finally -code {
set url [site_node::get_url -node_id $parent_id]
append url $name
- if { $directory_p == "t" } { append url "/" }
+ if { $directory_p eq "t" } { append url "/" }
nsv_set site_node_url_by_node_id $node_id $url
nsv_set site_nodes $url \
[list url $url node_id $node_id parent_id $parent_id name $name \
@@ -121,7 +121,7 @@
}
nsv_set site_node_url_by_object_id $object_id $url_by_object_id
- if { ![empty_string_p $package_key] } {
+ if { $package_key ne "" } {
set url_by_package_key [list $node(url)]
if { [nsv_exists site_node_url_by_package_key $package_key] } {
set url_by_package_key [concat [nsv_get site_node_url_by_package_key $package_key] $url_by_package_key]
@@ -189,14 +189,14 @@
@author Peter Marklund
} {
# Create a new node if none was provided and none exists
- if { [empty_string_p $node_id] } {
+ if { $node_id eq "" } {
# Default parent node to the main site
- if { [empty_string_p $parent_node_id ] } {
+ if { $parent_node_id eq "" } {
set parent_node_id [site_node::get_node_id -url "/"]
}
# Default node_name to package_key
- if { [empty_string_p $node_name] } {
+ if { $node_name eq "" } {
set node_name $package_key
}
@@ -219,7 +219,7 @@
}
# Default context id to the closest ancestor package_id
- if { [empty_string_p $context_id] } {
+ if { $context_id eq "" } {
set context_id [site_node::closest_ancestor_package -node_id $node_id]
}
@@ -258,7 +258,7 @@
nsv_array reset site_node_url_by_package_key [list]
set root_node_id [db_string get_root_node_id {} -default {}]
- if { ![empty_string_p $root_node_id] } {
+ if { $root_node_id ne "" } {
site_node::update_cache -sync_children -node_id $root_node_id
}
}
@@ -299,7 +299,7 @@
# Find the object_id previously mounted there
set cur_object_id $cur_node(object_id)
- if { ![empty_string_p $cur_object_id] } {
+ if { $cur_object_id ne "" } {
# Remove the URL from the url_by_object_id entry for that object_id
set cur_idx [lsearch -exact $url_by_object_id($cur_object_id) $cur_node_url]
if { $cur_idx != -1 } {
@@ -310,7 +310,7 @@
# Find the package_key previously mounted there
set cur_package_key $cur_node(package_key)
- if { ![empty_string_p $cur_package_key] } {
+ if { $cur_package_key ne "" } {
# Remove the URL from the url_by_package_key entry for that package_key
set cur_idx [lsearch -exact $url_by_package_key($cur_package_key) $cur_node_url]
if { $cur_idx != -1 } {
@@ -334,25 +334,25 @@
}
db_foreach $query_name {} {
- if {[empty_string_p $parent_id]} {
+ if {$parent_id eq ""} {
# url of root node
set url "/"
} else {
# append directory to url of parent node
set url $url_by_node_id($parent_id)
append url $name
- if { $directory_p == "t" } { append url "/" }
+ if { $directory_p eq "t" } { append url "/" }
}
# save new url
set url_by_node_id($node_id) $url
- if { ![empty_string_p $object_id] } {
+ if { $object_id ne "" } {
lappend url_by_object_id($object_id) $url
}
- if { ![empty_string_p $package_key] } {
+ if { $package_key ne "" } {
lappend url_by_package_key($package_key) $url
}
- if { [empty_string_p $package_id] } {
+ if { $package_id eq "" } {
set object_type ""
} else {
set object_type "apm_package"
@@ -401,15 +401,15 @@
The array elements are: package_id, package_key, object_type, directory_p,
instance_name, pattern_p, parent_id, node_id, object_id, url.
} {
- if {[empty_string_p $url] && [empty_string_p $node_id]} {
+ if {$url eq "" && $node_id eq ""} {
error "site_node::get \"must pass in either url or node_id\""
}
- if {![empty_string_p $node_id]} {
+ if {$node_id ne ""} {
return [get_from_node_id -node_id $node_id]
}
- if {![empty_string_p $url]} {
+ if {$url ne ""} {
return [get_from_url -url $url]
}
@@ -463,7 +463,7 @@
# attempt adding a / to the end of the url if it doesn't already have
# one
- if {![string equal [string index $url end] "/"]} {
+ if {[string index $url end] ne "/" } {
append url "/"
if {[nsv_exists site_nodes $url]} {
return [nsv_get site_nodes $url]
@@ -472,14 +472,14 @@
# chomp off part of the url and re-attempt
if {!$exact_p} {
- while {![empty_string_p $url]} {
+ while {$url ne ""} {
set url [string trimright $url /]
set url [string range $url 0 [string last / $url]]
if {[nsv_exists site_nodes $url]} {
array set node [nsv_get site_nodes $url]
- if {[string equal $node(pattern_p) t] && ![empty_string_p $node(object_id)]} {
+ if {$node(pattern_p) eq "t" && $node(object_id) ne ""} {
return [array get node]
}
}
@@ -578,7 +578,7 @@
return the site node id associated with the given object_id
} {
set url [lindex [get_url_from_object_id -object_id $object_id] 0]
- if { ![empty_string_p $url] } {
+ if { $url ne "" } {
return [get_node_id -url $url]
} else {
return {}
@@ -612,7 +612,7 @@
set result [list]
set array_result_p [string equal $element ""]
- while {![string equal $node_id ""]} {
+ while {$node_id ne "" } {
array set node [get -node_id $node_id]
if {$array_result_p} {
@@ -674,13 +674,13 @@
@author Lars Pind (lars@collaboraid.biz)
} {
- if { ![empty_string_p $package_type] && ![empty_string_p $package_key] } {
+ if { $package_type ne "" && $package_key ne "" } {
error "You may specify either package_type, package_key, or filter_element, but not more than one."
}
- if { ![empty_string_p $package_type] } {
+ if { $package_type ne "" } {
lappend filters package_type $package_type
- } elseif { ![empty_string_p $package_key] } {
+ } elseif { $package_key ne "" } {
lappend filters package_key $package_key
}
@@ -710,21 +710,21 @@
set passed_p 1
foreach { elm val } $filters {
- if { ![string equal $site_node($elm) $val] } {
+ if { $site_node($elm) ne $val } {
set passed_p 0
break
}
}
if { $passed_p } {
- if { ![empty_string_p $element] } {
+ if { $element ne "" } {
lappend return_val $site_node($element)
} else {
lappend return_val $child_url
}
}
}
}
- } elseif { ![empty_string_p $element] } {
+ } elseif { $element ne "" } {
set return_val [list]
foreach child_url $child_urls {
array unset site_node
@@ -736,7 +736,7 @@
# if we had filters or were getting a particular element then we
# have our results in return_val otherwise it's just urls
- if { ![empty_string_p $element]
+ if { $element ne ""
|| [llength $filters] > 0} {
return $return_val
} else {
@@ -776,16 +776,16 @@
@author Peter Marklund
} {
# Make sure we have a url to work with
- if { [empty_string_p $url] } {
- if { [empty_string_p $node_id] } {
+ if { $url eq "" } {
+ if { $node_id eq "" } {
set url "/"
} else {
set url [site_node::get_url -node_id $node_id]
}
}
# should we return the package at the passed-in node/url?
- if { $include_self_p && ![empty_string_p $package_key]} {
+ 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 } {
@@ -794,15 +794,15 @@
}
set elm_value {}
- while { [empty_string_p $elm_value] && $url != "/"} {
+ while { $elm_value eq "" && $url ne "/"} {
# move up a level
set url [string trimright $url /]
set url [string range $url 0 [string last / $url]]
array set node_array [site_node::get -url $url]
# are we looking for a specific package_key?
- if { [empty_string_p $package_key] || \
+ if { $package_key eq "" || \
[lsearch -exact $package_key $node_array(package_key)] != -1 } {
set elm_value $node_array($element)
}
@@ -846,7 +846,7 @@
set existing_urls [site_node::get_children -node_id $parent_node_id -element name]
array set parent_node [site_node::get -node_id $parent_node_id]
- if { ![empty_string_p $parent_node(package_key)] } {
+ if { $parent_node(package_key) ne "" } {
# Find all the page or directory names under this package
foreach path [glob -nocomplain -types d "[acs_package_root_dir $parent_node(package_key)]/www/*"] {
lappend existing_urls [lindex [file split $path] end]
@@ -862,10 +862,10 @@
}
}
- if { ![empty_string_p $folder] } {
+ if { $folder ne "" } {
if { [lsearch $existing_urls $folder] != -1 } {
# The folder is on the list
- if { [empty_string_p $current_node_id] } {
+ if { $current_node_id eq "" } {
# New node: Complain
return {}
} else {
@@ -880,7 +880,7 @@
}
} else {
# Autogenerate folder name
- if { [empty_string_p $instance_name] } {
+ if { $instance_name eq "" } {
error "Instance name must be supplied when folder name is empty."
}
@@ -934,7 +934,7 @@
db_transaction {
site_node::unmount -node_id $node_id
- if {[string equal $delete_p t]} {
+ if {$delete_p eq "t"} {
site_node::delete -node_id $node_id
}
}
@@ -995,7 +995,7 @@
@see site_node::closest_ancestor_package
} {
- if {[empty_string_p $url]} {
+ if {$url eq ""} {
set url [ad_conn url]
}
@@ -1008,7 +1008,7 @@
}
# Add a trailing slash and try again.
- if {[string index $url end] != "/"} {
+ if {[string index $url end] ne "/"} {
append url "/"
if {[catch {nsv_get site_nodes $url} result] == 0} {
array set node $result
@@ -1019,14 +1019,14 @@
}
# Try successively shorter prefixes.
- while {$url != ""} {
+ while {$url ne ""} {
# Chop off last component and try again.
set url [string trimright $url /]
set url [string range $url 0 [string last / $url]]
if {[catch {nsv_get site_nodes $url} result] == 0} {
array set node $result
- if {$node(pattern_p) == "t" && $node(object_id) != "" && [lsearch -exact $package_keys $node(package_key)] != -1 } {
+ if {$node(pattern_p) eq "t" && $node(object_id) ne "" && [lsearch -exact $package_keys $node(package_key)] != -1 } {
return $node(package_id)
}
}
@@ -1051,7 +1051,7 @@
@see site::node::closest_ancestor_package
} {
- if {[empty_string_p $package_key]} {
+ if {$package_key eq ""} {
set package_key [subsite::package_keys]
}
@@ -1060,7 +1060,7 @@
-package_key $package_key \
-url [ad_conn url] ]
- if {[empty_string_p $subsite_pkg_id]} {
+ if {$subsite_pkg_id eq ""} {
# No package was found... return the default
return $default
}
Index: openacs-4/packages/acs-tcl/tcl/sql-statement-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/Attic/sql-statement-procs.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-tcl/tcl/sql-statement-procs.tcl 6 Jun 2004 09:00:33 -0000 1.2
+++ openacs-4/packages/acs-tcl/tcl/sql-statement-procs.tcl 10 Jan 2007 21:22:12 -0000 1.3
@@ -72,19 +72,19 @@
Adds to the SQL statement.
} {
upvar $sqlarrayname sql
- if { ![empty_string_p $select] } {
+ if { $select ne "" } {
lappend sql(select) $select
}
- if { ![empty_string_p $from] } {
+ if { $from ne "" } {
lappend sql(from) $from
}
- if { ![empty_string_p $where] } {
+ if { $where ne "" } {
lappend sql(where) $where
}
- if { ![empty_string_p $groupby] } {
+ if { $groupby ne "" } {
lappend sql(groupby) $groupby
}
- if { ![empty_string_p $orderby] } {
+ if { $orderby ne "" } {
lappend sql(orderby) $orderby
}
}
Index: openacs-4/packages/acs-tcl/tcl/stack-trace-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/stack-trace-procs.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-tcl/tcl/stack-trace-procs.tcl 17 Feb 2005 15:12:58 -0000 1.2
+++ openacs-4/packages/acs-tcl/tcl/stack-trace-procs.tcl 10 Jan 2007 21:22:12 -0000 1.3
@@ -22,12 +22,12 @@
} {
uplevel {
global errorInfo
- if {![empty_string_p $errorInfo]} {
+ if {$errorInfo ne ""} {
set callStack [list $errorInfo "invoked from within"]
} else {
set callStack {}
}
- for {set i [info level]} {$i > 0} {set i [expr $i - 1]} {
+ for {set i [info level]} {$i > 0} {set i [expr {$i - 1}]} {
set call [info level $i]
if {[string length $call] > 160} {
set call "[string range $call 0 150]..." }
Index: openacs-4/packages/acs-tcl/tcl/table-display-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/Attic/table-display-procs.tcl,v
diff -u -r1.11 -r1.12
--- openacs-4/packages/acs-tcl/tcl/table-display-procs.tcl 28 Aug 2003 09:41:43 -0000 1.11
+++ openacs-4/packages/acs-tcl/tcl/table-display-procs.tcl 10 Jan 2007 21:22:12 -0000 1.12
@@ -45,15 +45,15 @@
} {
set html {}
- if {[empty_string_p $option_list]} {
+ if {$option_list eq ""} {
return
}
- if {[empty_string_p $options_set]} {
+ if {$options_set eq ""} {
set options_set [ns_getform]
}
- if {[empty_string_p $url]} {
+ if {$url eq ""} {
set url [ad_conn url]
}
@@ -73,10 +73,10 @@
# check if a default is set otherwise the first value is used
set option_key [lindex $option 0]
set option_val {}
- if { ! [empty_string_p $options_set]} {
+ if { $options_set ne ""} {
set option_val [ns_set get $options_set $option_key]
}
- if { [empty_string_p $option_val] } {
+ if { $option_val eq "" } {
set option_val [lindex $option 2]
}
@@ -89,7 +89,7 @@
append html " | "
}
- if {[string compare $option_val $thisoption] == 0} {
+ if {$option_val eq $thisoption } {
append html "<strong>[lindex $option_value 1]</strong>"
} else {
append html "<a href=\"$url?[export_ns_set_vars "url" $option_key $options_set]&[ns_urlencode $option_key]=[ns_urlencode $thisoption]\">[lindex $option_value 1]</a>"
@@ -108,11 +108,11 @@
} {
set out {}
- if {[empty_string_p $option_list]} {
+ if {$option_list eq ""} {
return
}
- if {[empty_string_p $options_set]} {
+ if {$options_set eq ""} {
set options_set [ns_getform]
}
@@ -122,20 +122,20 @@
set option_key [lindex $option 0]
set option_val {}
# get the option from the form
- if { ! [empty_string_p $options_set]} {
+ if { $options_set ne ""} {
set option_val [ns_set get $options_set $option_key]
}
#otherwise get from default
- if { [empty_string_p $option_val] } {
+ if { $option_val eq "" } {
set option_val [lindex $option 2]
}
foreach option_value [lindex $option 3] {
set thisoption [lindex $option_value 0]
- if {[string compare $option_val $thisoption] == 0} {
+ if {$option_val eq $thisoption } {
set code [lindex $option_value 2]
- if {![empty_string_p $code]} {
- if {[string compare [lindex $code 0] $what] == 0} {
+ if {$code ne ""} {
+ if {[lindex $code 0] eq $what } {
append out " $joiner [uplevel [list subst [lindex $code 1]]]"
}
}
@@ -156,11 +156,11 @@
} {
set out {}
- if {[empty_string_p $option_list]} {
+ if {$option_list eq ""} {
return
}
- if {[empty_string_p $options_set]} {
+ if {$options_set eq ""} {
set options_set [ns_getform]
}
@@ -170,7 +170,7 @@
set option_key [lindex $option 0]
set option_val {}
# get the option from the form
- if { ! [empty_string_p $options_set] && [ns_set find $options_set $option_key] != -1} {
+ if { $options_set ne "" && [ns_set find $options_set $option_key] != -1} {
uplevel [list set $option_key [ns_set get $options_set $option_key]]
} else {
uplevel [list set $option_key [lindex $option 2]]
@@ -290,7 +290,7 @@
set Tform [ad_conn form]
# export variables from calling environment
- if {![empty_string_p $Textra_vars]} {
+ if {$Textra_vars ne ""} {
foreach Tvar $Textra_vars {
upvar $Tvar $Tvar
}
@@ -300,14 +300,14 @@
set Torderbykey {::not_sorted::}
set Treverse {}
regexp {^([^*,]+)([*])?} $Torderby match Torderbykey Treverse
- if {$Treverse == "*"} {
+ if {$Treverse eq "*"} {
set Torder desc
} else {
set Torder asc
}
# set up the target url for new sorts
- if {[empty_string_p $Torder_target_url]} {
+ if {$Torder_target_url eq ""} {
set Torder_target_url [ad_conn url]
}
set Texport "[uplevel [list export_ns_set_vars url [list orderby$Tsuffix]]]&"
@@ -325,7 +325,7 @@
# generate the header code
#
append Theader "<table $Ttable_extra_html>\n"
- if {[empty_string_p $Theader_row_extra]} {
+ if {$Theader_row_extra eq ""} {
append Theader "<tr>\n"
} else {
append Theader "<tr $Theader_row_extra>\n"
@@ -334,18 +334,18 @@
set Tcol [lindex $Tdatadef $Ti]
if { ( [ns_set find $selection [lindex $Tcol 0]] < 0
&& ([empty_string_p [lindex $Tcol 2]] ||
- ([string compare [lindex $Tcol 2] "sort_by_pos"] != 0)
+ ([lindex $Tcol 2] ne "sort_by_pos" )
)
)
- || [string compare [lindex $Tcol 2] no_sort] == 0
+ || [lindex $Tcol 2] eq "no_sort"
} {
# not either a column in the select or has sort code
# then just a plain text header so do not do sorty things
append Theader " <th>[lindex $Tcol 1]</th>\n"
} else {
- if {[string compare [lindex $Tcol 0] $Torderbykey] == 0} {
- if {$Torder == "desc"} {
+ if {[lindex $Tcol 0] eq $Torderbykey } {
+ if {$Torder eq "desc"} {
set Tasord $Tasc_order_img
} else {
set Tasord $Tdesc_order_img
@@ -379,7 +379,7 @@
if { $Tpost_data && $Tpost_data <= [llength $Tpost_data_ns_sets] } {
# bind the Tpost_data_ns_sets row of the passed in data
- set_variables_after_query_not_selection [lindex $Tpost_data_ns_sets [expr $Tpost_data - 1]]
+ set_variables_after_query_not_selection [lindex $Tpost_data_ns_sets [expr {$Tpost_data - 1}]]
} elseif { $Tpost_data } {
# past the end of the fake data drop out.
break
@@ -402,10 +402,10 @@
# first check if we are in audit mode and if the audit columns have changed
set Tdisplay_changes_only 0
- if {![empty_string_p $Taudit] && $Tcount > 0} {
+ if {$Taudit ne "" && $Tcount > 0} {
# check if the audit key columns changed
foreach Taudit_key $Taudit {
- if {[string compare [set $Taudit_key] [set P$Taudit_key]] == 0} {
+ if {[set $Taudit_key] eq [set P$Taudit_key] } {
set Tdisplay_changes_only 1
}
}
@@ -468,7 +468,7 @@
}
if { $Tdisplay_changes_only
- && [string compare $Tdisplay_field $Tlast_display($Ti)] == 0} {
+ && $Tdisplay_field eq $Tlast_display($Ti) } {
set Tdisplay_field {<td> </td>}
} else {
set Tlast_display($Ti) $Tdisplay_field
@@ -482,7 +482,7 @@
# so on next row we can say things like if $Pvar != $var not blank
if { $Tpost_data && $Tpost_data <= [llength $Tpost_data_ns_sets] } {
# bind the Tpost_data_ns_sets row of the passed in data
- set_variables_after_query_not_selection [lindex $Tpost_data_ns_sets [expr $Tpost_data - 1]] P
+ set_variables_after_query_not_selection [lindex $Tpost_data_ns_sets [expr {$Tpost_data - 1}]] P
} else {
set_variables_after_query_not_selection $selection P
}
@@ -511,21 +511,21 @@
-sortable from t/f/all
} {
set column_list {}
- if {[empty_string_p $columns]} {
+ if {$columns eq ""} {
for {set i 0} {$i < [llength $datadef]} {incr i} {
- if {$sortable == "all"
- || ($sortable == "t" && [lindex [lindex $datadef $i] 2] != "no_sort")
- || ($sortable == "f" && [lindex [lindex $datadef $i] 2] == "no_sort")
+ if {$sortable eq "all"
+ || ($sortable eq "t" && [lindex [lindex $datadef $i] 2] != "no_sort")
+ || ($sortable eq "f" && [lindex [lindex $datadef $i] 2] == "no_sort")
} {
lappend column_list $i
}
}
} else {
set colnames {}
foreach col $datadef {
- if {$sortable == "all"
- || ($sortable == "t" && [lindex $col 2] != "no_sort")
- || ($sortable == "f" && [lindex $col 2] == "no_sort")
+ if {$sortable eq "all"
+ || ($sortable eq "t" && [lindex $col 2] ne "no_sort")
+ || ($sortable eq "f" && [lindex $col 2] eq "no_sort")
} {
lappend colnames [lindex $col 0]
} else {
@@ -594,32 +594,32 @@
set n_sel_columns [llength $sel_columns]
set html {}
- if {[string compare $item "CreateNewCustom"] == 0} {
+ if {$item eq "CreateNewCustom" } {
set item {}
}
# now spit out the form fragment.
- if {![empty_string_p $item]} {
+ if {$item ne ""} {
append html "<h2>Editing <strong>$item</strong></h2>"
append html "<form method=\"get\" action=\"/tools/table-custom\">"
append html "<input type=\"submit\" value=\"Delete this view\" />"
append html "<input type=\"hidden\" name=\"delete_the_view\" value=\"1\" />"
append html "[export_form_vars item_group item]"
- if {![empty_string_p $return_url]} {
+ if {$return_url ne ""} {
append html "[export_form_vars return_url]"
}
append html "</form>"
}
append html "<form method=get action=\"/tools/table-custom\">"
- if {![empty_string_p $return_url]} {
+ if {$return_url ne ""} {
append html "[export_form_vars return_url]"
}
- if {[empty_string_p $item_group]} {
+ if {$item_group eq ""} {
set item_group [ad_conn url]
}
append html "[export_form_vars item_group]"
- if {![empty_string_p $item]} {
+ if {$item ne ""} {
set item_original $item
append html "[export_form_vars item_original]"
append html "<input type=\"submit\" value=\"Save changes\" />"
@@ -629,13 +629,13 @@
append html "<table>"
append html "<tr><th>Name:</th><td><input type=\"text\" size=\"60\" name=\"item\" [export_form_value item] /></td></tr>"
- if {![empty_string_p $item]} {
+ if {$item ne ""} {
set item_original item
append html "[export_form_vars item_original]"
append html "<tr><td> </td><td><em>Editing the name will rename the view</em></td></tr>"
}
- if {[string compare $type select] == 0} {
+ if {$type eq "select" } {
# select table
set options "<option value=\"\">---</option>"
foreach opt $sel_list {
@@ -649,7 +649,7 @@
} else {
set out $options
}
- append html "<tr><th>[expr $i + 1]</th><td><select name=\"col\">$out</select></td></tr>\n"
+ append html "<tr><th>[expr {$i + 1}]</th><td><select name=\"col\">$out</select></td></tr>\n"
}
} else {
# radio button table
@@ -670,7 +670,7 @@
set out $options
}
regsub -all {@@} $out $i out
- append html "<tr><th>[expr $i + 1]</th>$out</tr>\n"
+ append html "<tr><th>[expr {$i + 1}]</th>$out</tr>\n"
}
}
append html "</table></form>"
@@ -706,7 +706,7 @@
set direction [list]
foreach col $full_column {
regexp {([^*,]+)([*])?} $col match coln dirn
- if {$dirn == "*"} {
+ if {$dirn eq "*"} {
set dirn desc
} else {
set dirn asc
@@ -719,32 +719,32 @@
set n_sel_columns [llength $sel_columns]
set html {}
- if {[string compare $item "CreateNewCustom"] == 0} {
+ if {$item eq "CreateNewCustom" } {
set item {}
}
# now spit out the form fragment.
- if {![empty_string_p $item]} {
+ if {$item ne ""} {
append html "<h2>Editing <strong>$item</strong></h2>"
append html "<form method=\"get\" action=\"/tools/sort-custom\">"
append html "<input type=\"submit\" value=\"Delete this sort\" />"
append html "<input type=\"hidden\" name=\"delete_the_sort\" value=\"1\" />"
append html "[export_form_vars item_group item]"
- if {![empty_string_p $return_url]} {
+ if {$return_url ne ""} {
append html "[export_form_vars return_url]"
}
append html "</form>"
}
append html "<form method=get action=\"/tools/sort-custom\">"
- if {![empty_string_p $return_url]} {
+ if {$return_url ne ""} {
append html "[export_form_vars return_url]"
}
- if {[empty_string_p $item_group]} {
+ if {$item_group eq ""} {
set item_group [ad_conn url]
}
append html "[export_form_vars item_group]"
- if {![empty_string_p $item]} {
+ if {$item ne ""} {
set item_original $item
append html "[export_form_vars item_original]"
append html "<input type=\"submit\" value=\"Save changes\">"
@@ -754,7 +754,7 @@
append html "<table>"
append html "<tr><th>Name:</th><td><input type=\"text\" size=\"60\" name=\"item\" [export_form_value item]></td></tr>"
- if {![empty_string_p $item]} {
+ if {$item ne ""} {
set item_original item
append html "[export_form_vars item_original]"
append html "<tr><td> </td><td><em>Editing the name will rename the sort</em></td></tr>"
@@ -772,7 +772,7 @@
} else {
set out $options
}
- append html "<tr><th>[expr $i + 1]</th><td><select name=\"col\">$out</select>"
+ append html "<tr><th>[expr {$i + 1}]</th><td><select name=\"col\">$out</select>"
switch [lindex $direction $i] {
asc {
append html "<select name=\"dir\"><option value=\"asc\" selected=\"selected\">increasing</option><option value=\"desc\">decreasing</option></select>"
@@ -800,20 +800,20 @@
# if there's a "*" after the key, we want to reverse the usual order
foreach order_spec $tabledef {
if { $sort_key == [lindex $order_spec 0] } {
- if { $reverse == "*" } {
+ if { $reverse eq "*" } {
set order "desc"
} else {
set order "asc"
}
- if { $order_by_clause == "" } {
+ if { $order_by_clause eq "" } {
append order_by_clause "\norder by "
} else {
append order_by_clause ", "
}
# tack on the order by clause
- if {![empty_string_p [lindex $order_spec 2]] && ([string compare [lindex $order_spec 2] "sort_by_pos"] != 0)} {
+ if {![empty_string_p [lindex $order_spec 2]] && ([lindex $order_spec 2] ne "sort_by_pos" )} {
append order_by_clause "[subst [lindex $order_spec 2]]"
} else {
append order_by_clause "$sort_key $order"
@@ -838,12 +838,12 @@
sort key to reorder, the things which have the same value for the newly-sorted
column will remain in the same relative order.
} {
- if { $keys == "" } {
+ if { $keys eq "" } {
return $key
} elseif { [regexp "^${key}(\\*?)," "$keys," match reverse] } {
# if this was already the first key, then reverse order
- if { $reverse == "*" } {
+ if { $reverse eq "*" } {
regsub "\\*," "$keys," "," keys
} else {
regsub "," "$keys," "*," keys
@@ -860,7 +860,7 @@
proc_doc ad_same_page_link {variable value text {form ""}} {
Makes a link to this page, with a new value for "variable".
} {
- if { [empty_string_p $form] } {
+ if { $form eq "" } {
set form [ns_getform]
}
set url_vars [export_ns_set_vars url $variable $form]
@@ -913,7 +913,7 @@
set break {}
foreach item $items {
- if {[string compare $item_set $item] == 0} {
+ if {$item_set eq $item } {
append html "$break<strong>$item</strong> (<a href=\"$custom_url$item\">edit</a>)"
} else {
append html "$break<a href=\"$target_url$item\">$item</a>"
@@ -931,8 +931,8 @@
empty do a returnredirect with the defaults set
} {
set form [ns_getform]
- if {[empty_string_p $form]
- && ![empty_string_p $defaults]} {
+ if {$form eq ""
+ && $defaults ne ""} {
# we did not get a form so set all the variables
# and redirect to set them
set redirect "[ad_conn url]?"
@@ -958,10 +958,10 @@
sets up the head of a form to feed to /tools/form-custom.tcl
} {
append html "<form method=\"get\" action=\"/tools/form-custom\">\n"
- if {![empty_string_p $return_url]} {
+ if {$return_url ne ""} {
append html "[export_form_vars return_url]\n"
}
- if {[empty_string_p $item_group]} {
+ if {$item_group eq ""} {
set item_group [ad_conn url]
}
set item_original $item
@@ -979,14 +979,14 @@
append html "<tr><th align=\"left\">[lindex $opt 1]</th><td>"
append html "<select name=\"[lindex $opt 0]\">"
#append html "<option value=\"\">-- Unset --</option>"
- if {![empty_string_p $current]
+ if {$current ne ""
&& [ns_set find $current [lindex $opt 0]] > -1} {
set picked [ns_set get $current [lindex $opt 0]]
} else {
set picked [lindex $opt 2]
}
foreach val [lindex $opt 3] {
- if {[string compare $picked [lindex $val 0]] == 0} {
+ if {$picked eq [lindex $val 0] } {
append html "<option selected=\"selected\" value=\"[philg_quote_double_quotes [lindex $val 0]]\">[lindex $val 1]</option>\n"
} else {
append html "<option value=\"[philg_quote_double_quotes [lindex $val 0]]\">[lindex $val 1]</option>\n"
@@ -1003,7 +1003,7 @@
} {
set orderclause "order by $orderby $order"
foreach col $datadef {
- if {[string compare $orderby [lindex $col 0]] == 0} {
+ if {$orderby eq [lindex $col 0] } {
if {![empty_string_p [lindex $col 2]]} {
set orderclause [subst [lindex $col 2]]
}
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 -r1.21 -r1.22
--- openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl 1 Nov 2006 19:12:54 -0000 1.21
+++ openacs-4/packages/acs-tcl/tcl/tcl-documentation-procs.tcl 10 Jan 2007 21:22:12 -0000 1.22
@@ -91,12 +91,12 @@
global ad_page_contract_complaints ad_page_contract_errorkeys ad_page_contract_error_string
# if no key was specified, grab one from the internally kept stack
- if { [empty_string_p $key] && [info exists ad_page_contract_errorkeys] } {
+ if { $key eq "" && [info exists ad_page_contract_errorkeys] } {
set key [lindex $ad_page_contract_errorkeys 0]
}
if { [info exists ad_page_contract_error_string($key)] } {
lappend ad_page_contract_complaints $ad_page_contract_error_string($key)
- } elseif { [empty_string_p $message] } {
+ } elseif { $message eq "" } {
lappend ad_page_contract_complaints "[_ acs-tcl.lt_Validation_key_compla]"
} else {
lappend ad_page_contract_complaints $message
@@ -155,11 +155,11 @@
}
set name [lindex $errorkeyv 0]
set flags [lindex $errorkeyv 1]
- if { [empty_string_p $flags] } {
+ if { $flags eq "" } {
set ad_page_contract_error_string($name) $text
} else {
foreach flag [split $flags ","] {
- if { ![empty_string_p $flag] } {
+ if { $flag ne "" } {
set ad_page_contract_error_string($name:$flag) $text
} else {
set ad_page_contract_error_string($name) $text
@@ -258,7 +258,7 @@
} {
foo
bar:integer,notnull,multiple,trim
- {greble:integer {[expr [lindex $bar 0] + 1]}}
+ {greble:integer {[expr {[lindex $bar 0] + 1}]}}
} -validate {
greble_is_in_range -requires {greble:integer} {
if { $greble < 1 || $greble > 100 } {
@@ -625,11 +625,11 @@
if { $left_paren == -1 } {
lappend flag_list $flag
} else {
- if { ![string equal [string index $flag end] ")"] } {
+ if { [string index $flag end] ne ")" } {
return -code error "Missing or misplaced end parenthesis for flag '$flag' on argument '$name'"
}
- set flag_parameters [string range $flag [expr $left_paren + 1] [expr [string length $flag]-2]]
- set flag [string range $flag 0 [expr $left_paren - 1]]
+ set flag_parameters [string range $flag [expr {$left_paren + 1}] [expr {[string length $flag]-2}]]
+ set flag [string range $flag 0 [expr {$left_paren - 1}]]
lappend flag_list $flag
foreach flag_parameter [split $flag_parameters "|"] {
@@ -739,7 +739,7 @@
}
# If there are no query arguments to process, we're done
- if { ![info exists query] || [empty_string_p $query] } {
+ if { ![info exists query] || $query eq "" } {
return
}
@@ -777,7 +777,7 @@
incr i
if { [string index [lindex $validate $i] 0] == "-" } {
- if { ![string equal [lindex $validate $i] -requires] } {
+ if { [lindex $validate $i] ne "-requires" } {
return -code error "[_ acs-tcl.lt_Valid_switches_are_-r]"
}
set requires [lindex $validate [incr i]]
@@ -792,7 +792,7 @@
return -code error "[_ acs-tcl.lt_The_-requires_element_1]"
}
set req_filter [lindex $parts_v 1]
- if { [string equal $req_filter array] || [string equal $req_filter multiple] } {
+ if { $req_filter eq "array" || $req_filter eq "multiple" } {
return -code error "You can't require \"$req_name:$req_filter\" for block \"$name\"."
}
}
@@ -820,11 +820,11 @@
#
####################
- if { [empty_string_p $form] } {
+ if { $form eq "" } {
set form [ns_getform]
}
- if { [empty_string_p $form] } {
+ if { $form eq "" } {
set form_size 0
} else {
set form_size [ns_set size $form]
@@ -879,7 +879,7 @@
set formal_name [join [lrange $actual_name_v 0 $i] "."]
if { [info exists apc_internal_filter($formal_name:array)] } {
set found_p 1
- set variable_to_set var([join [lrange $actual_name_v [expr $i+1] end] "."])
+ set variable_to_set var([join [lrange $actual_name_v [expr {$i+1}] end] "."])
break
}
}
@@ -891,7 +891,7 @@
}
}
- if { [info exists apc_internal_filter($formal_name:multiple)] && [empty_string_p $actual_value] } {
+ 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
@@ -911,7 +911,7 @@
ad_page_contract_set_validation_passed $formal_name:trim
}
- if { [empty_string_p $actual_value] } {
+ if { $actual_value eq "" } {
if { [info exists apc_internal_filter($formal_name:notnull)] } {
ad_complain -key $formal_name:notnull "[_ acs-tcl.lt_You_must_specify_some]"
continue
@@ -972,17 +972,17 @@
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)] || [empty_string_p $apc_default_value($formal_name)]) } {
+ 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 ""
foreach arrayvar [ns_cache names util_memoize] {
if [regexp [list [ad_conn session_id] [ad_conn package_id] "$formal_name."] $arrayvar] {
- set arrayvar [lindex $arrayvar [expr [llength $arrayvar] - 1]]
- if { ![empty_string_p $array_list] } {
+ set arrayvar [lindex $arrayvar [expr {[llength $arrayvar] - 1}]]
+ if { $array_list ne "" } {
append array_list " "
}
- set arrayvar_formal [string range $arrayvar [expr [string first "." $arrayvar] + 1] [string length $arrayvar]]
+ set arrayvar_formal [string range $arrayvar [expr {[string first "." $arrayvar] + 1}] [string length $arrayvar]]
append array_list "{$arrayvar_formal} {[ad_get_client_property [ad_conn package_id] $arrayvar]}"
}
}
@@ -1090,9 +1090,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 { [empty_string_p $validation_ok_p] || \
- (![string equal $validation_ok_p 1] && ![string equal $validation_ok_p 0])} {
- set validation_ok_p [expr [ad_complaints_count] == $no_complaints_before]
+ 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}]
}
if { $validation_ok_p } {
@@ -1204,7 +1204,7 @@
}
# trim leading zeros, so as not to confuse Tcl
set value [string trimleft $value "0"]
- if { [empty_string_p $value] } {
+ if { $value eq "" } {
# but not all of the zeros
set value "0"
}
@@ -1261,10 +1261,10 @@
@creation-date 25 July 2000
} {
- if { ![string is wordchar $name] || [empty_string_p $name] } {
+ if { ![string is wordchar $name] || $name eq "" } {
return -code error "[_ acs-tcl.lt_Flag_name_must_be_a_v]"
}
- if { ![string equal [string tolower $name] $name] } {
+ if { [string tolower $name] ne $name } {
return -code error "[_ acs-tcl.lt_Flag_names_must_be_al]"
}
if { ![string match $type filter] && ![string match $type post] } {
@@ -1289,12 +1289,12 @@
set prior_type [ad_page_contract_filter_type $name]
- if { [string equal $prior_type internal] } {
+ if {$prior_type eq "internal"} {
ns_mutex unlock $mutex
return -code error "[_ acs-tcl.lt_The_flag_name_name_is]"
- } elseif { ![empty_string_p $prior_type] } {
+ } elseif { $prior_type ne "" } {
set prior_script [ad_page_contract_filter_script $name]
- if { ![string equal $prior_script $script] } {
+ if { $prior_script ne $script } {
ns_log Warning "[_ acs-tcl.lt_Multiple_definitions_]"
}
}
@@ -1385,7 +1385,7 @@
@creation-date 25 July 2000
} {
upvar $value_varname value
- if { [empty_string_p $parameters] } {
+ if { $parameters eq "" } {
set filter_result [[ad_page_contract_filter_proc $filter] $name value]
} else {
set filter_result [[ad_page_contract_filter_proc $filter] $name value $parameters]
@@ -1450,7 +1450,7 @@
if { [nsv_exists ad_page_contract_filter_rules $name] } {
set prior_script [ad_page_contract_filter_rule_script $name]
- if { ![string equal $script $prior_script] } {
+ if { $script ne $prior_script } {
ns_log Warning "Multiple definitions of the ad_page_contract_filter_rule \"$name\" in $script and $prior_script"
}
}
@@ -1579,7 +1579,7 @@
@creation-date 25 July 2000
} {
set naughty_prompt [ad_html_security_check $value]
- if { ![empty_string_p $naughty_prompt] } {
+ if { $naughty_prompt ne "" } {
ad_complain $naughty_prompt
return 0
}
@@ -1596,7 +1596,7 @@
# check to make sure path is to an authorized directory
set tmpdir_list [ad_parameter_all_values_as_list -package_id [site_node_closest_ancestor_package "acs-subsite"] TmpDir]
- if { [empty_string_p $tmpdir_list] } {
+ if { $tmpdir_list eq "" } {
set tmpdir_list [list "/var/tmp" "/tmp"]
}
@@ -1639,7 +1639,7 @@
set date($date_element) $real_value
}
- if { ![empty_string_p $date(year)] && [string length $date(year)] != 4 } {
+ if { $date(year) ne "" && [string length $date(year)] != 4 } {
ad_complain "[_ acs-tcl.lt_Invalid_date_The_year]"
return 0
}
@@ -1648,13 +1648,13 @@
set date(month) $real_value
} else {
set months_list {January February March April May June July August September October November December}
- set date(month) [expr [lsearch $months_list $date(month)] + 1]
+ set date(month) [expr {[lsearch $months_list $date(month)] + 1}]
}
if {
- [string match "" $date(month)] \
- || [string match "" $date(day)] \
- || [string match "" $date(year)] \
+ "" eq $date(month) \
+ || "" eq $date(day) \
+ || "" eq $date(year) \
|| $date(month) < 1 || $date(month) > 12 \
|| $date(day) < 1 || $date(day) > 31 \
|| $date(year) < 1 \
@@ -1704,9 +1704,9 @@
}
if {
- [string match "" $time(hours)] \
- || [string match "" $time(minutes)] \
- || [string match "" $time(seconds)] \
+ "" 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 \
@@ -1748,9 +1748,9 @@
}
if {
- [string match "" $time(hours)] \
- || [string match "" $time(minutes)] \
- || [string match "" $time(seconds)] \
+ "" eq $time(hours) \
+ || "" eq $time(minutes) \
+ || "" eq $time(seconds) \
|| $time(hours) < 0 || $time(hours) > 23 \
|| $time(minutes) < 0 || $time(minutes) > 59 \
|| $time(seconds) < 0 || $time(seconds) > 59
@@ -1788,7 +1788,7 @@
@author Randy Beggs (randyb@arsdigita.com)
@creation-date August 2000
} {
- if { [lindex $length 0] == "min" } {
+ if { [lindex $length 0] eq "min" } {
if { [string length $value] < [lindex $length 1] } {
ad_complain "[_ acs-tcl.lt_name_is_too_short__Pl_1]"
return 0
@@ -1842,7 +1842,7 @@
}
# trim leading zeros, so as not to confuse Tcl
set value [string trimleft $value "0"]
- if { [empty_string_p $value] } {
+ if { $value eq "" } {
# but not all of the zeros
set value "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 -r1.49 -r1.50
--- openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 15 Dec 2006 00:02:00 -0000 1.49
+++ openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 10 Jan 2007 21:22:12 -0000 1.50
@@ -30,13 +30,13 @@
semi-HTML input and preserve that formatting. This will also cause spaces/tabs to not be
replaced with nbsp's, because this can too easily mess up HTML tags.
@param includes_html Set this if the text parameter already contains some HTML which should be preserved.
- @param encode This will encode international characters into it's html equivalent, like "�" into ü
+ @param encode This will encode international characters into it's html equivalent, like "ü" into ü
@author Branimir Dolicki (branimir@arsdigita.com)
@author Lars Pind (lars@pinds.com)
@creation-date 19 July 2000
} {
- if { [empty_string_p $text] } {
+ if { $text eq "" } {
return {}
}
@@ -81,13 +81,13 @@
if { $encode_p} {
set myChars {
- � � � � � � � � � �
- � � � � � � � � � �
- � � � � � � � � � �
- � � � � � � � � � �
- � � � � � � � � � �
- � � � � � � � � � �
- � � � � �
+ ª º À Á Â Ã Ä Å Æ Ç
+ È É Ê Ë Ì Í Î Ï Ð Ñ
+ Ò Ó Ô Õ Ö Ø Ù Ú Û Ü
+ Ý Þ ß à á â ã ä å æ
+ ç è é ê ë ì í î ï ð
+ ñ ò ó ô õ ö ø ù ú û
+ ü ý þ ÿ ¿
}
set myHTML {
@@ -178,7 +178,7 @@
# Last <p> tag
set idx [string last "<p>" [string tolower $text]]
if { $idx != -1 } {
- set text "[string range $text 0 [expr $idx-1]]<p style=\"margin-bottom: 0px;\">[string range $text [expr $idx+3] end]"
+ set text "[string range $text 0 [expr {$idx-1}]]<p style=\"margin-bottom: 0px;\">[string range $text [expr {$idx+3}] end]"
}
return $text
@@ -355,20 +355,20 @@
if { ! $discard } {
# figure out if we can break with the pretag chunk
if { $break_soft } {
- if {! $nobr && [expr [string length $pretag] + $out_len] > $break_soft } {
+ if {! $nobr && [expr {[string length $pretag] + $out_len}] > $break_soft } {
# first chop pretag to the right length
- set pretag [string range $pretag 0 [expr $break_soft - $out_len - [string length $ellipsis]]]
+ set pretag [string range $pretag 0 [expr {$break_soft - $out_len - [string length $ellipsis]}]]
# clip the last word
regsub "\[^ \t\n\r]*$" $pretag {} pretag
append out [string range $pretag 0 $break_soft]
set broken_p 1
break
- } elseif { $nobr && [expr [string length $pretag] + $out_len] > $break_hard } {
+ } elseif { $nobr && [expr {[string length $pretag] + $out_len}] > $break_hard } {
# we are in a nonbreaking tag and are past the hard break
# so chop back to the point we got the nobr tag...
set tagptr $nobr_tagptr
if { $nobr_out_point > 0 } {
- set out [string range $out 0 [expr $nobr_out_point - 1]]
+ set out [string range $out 0 [expr {$nobr_out_point - 1}]]
} else {
# here maybe we should decide if we should keep the tag anyway
# if zero length result would be the result...
@@ -385,7 +385,7 @@
}
# now deal with the tag if we got one...
- if { $tag == "" } {
+ if { $tag eq "" } {
# if the tag is empty we might have one of the bad matched that are not eating
# any of the string so check for them
if {[string length $match] == [string length $frag]} {
@@ -401,12 +401,12 @@
append out $fulltag
}
} else {
- if { $close != "/" } {
+ if { $close ne "/" } {
# new tag
# "remove" tags are just ignored here
# discard tags
if { $discard } {
- if { $syn($tag) == "discard" } {
+ if { $syn($tag) eq "discard" } {
incr discard
incr tagptr
set tagstack($tagptr) $tag
@@ -441,7 +441,7 @@
if { $discard } {
# if we are in discard mode only watch for
# closes to discarded tags
- if { $syn($tag) == "discard"} {
+ if { $syn($tag) eq "discard"} {
if {$tagptr > -1} {
if { $tag != $tagstack($tagptr) } {
#puts "/$tag without $tag"
@@ -452,14 +452,14 @@
}
}
} else {
- if { $syn($tag) != "remove"} {
+ if { $syn($tag) ne "remove"} {
# if tag is a remove tag we just ignore it...
if {$tagptr > -1} {
if {$tag != $tagstack($tagptr) } {
# puts "/$tag without $tag"
} else {
incr tagptr -1
- if { $syn($tag) == "nobr"} {
+ if { $syn($tag) eq "nobr"} {
incr nobr -1
}
append out $fulltag
@@ -478,7 +478,7 @@
# Chop off extra whitespace at the end
if { $broken_p } {
- set end_index [expr [string length $out] -1]
+ set end_index [expr {[string length $out] -1}]
while { $end_index >= 0 && [string is space [string index $out $end_index]] } {
incr end_index -1
}
@@ -489,7 +489,7 @@
set tag $tagstack($i)
# LARS: Only close tags which we aren't supposed to remove
- if { ![string equal $syn($tag) "discard"] && ![string equal $syn($tag) "remove"] } {
+ if { $syn($tag) ne "discard" && $syn($tag) ne "remove" } {
append out "</$tagstack($i)>"
}
}
@@ -598,7 +598,7 @@
set count 0
while { $i < [string length $html] && ![string equal [string index $html $i] {>}] } {
if { [incr count] > 1000 } {
- error "There appears to be a programming bug in ad_parse_html_attributes_upvar: We've entered an infinite loop. We are here: \noffset $i: [string range $html $i [expr $i + 60]]"
+ error "There appears to be a programming bug in ad_parse_html_attributes_upvar: We've entered an infinite loop. We are here: \noffset $i: [string range $html $i [expr {$i + 60}]]"
}
if { [string equal [string range $html $i [expr { $i + 1 }]] "/>"] } {
# This is an XML-style tag ending: <... />
@@ -739,7 +739,7 @@
return "The attribute '$attr_name' is not allowed for $tagname tags"
}
- if { ![string equal [string tolower $attr_name] "style"] } {
+ 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(*)] } {
return "Your URLs can only use these protocols: [join $allowed_protocols_list ", "].
@@ -808,10 +808,10 @@
# - alpha or
# - a slash, and then alpha
# Otherwise, it's probably just a lone < character
- if { $i >= [expr $length-1] || \
- (![string is alpha [string index $html [expr $i + 1]]] && \
- (![string equal "/" [string index $html [expr $i + 1]]] || \
- ![string is alpha [string index $html [expr $i + 2]]])) } {
+ if { $i >= [expr {$length-1}] || \
+ (![string is alpha [string index $html [expr {$i + 1}]]] && \
+ (![string equal "/" [string index $html [expr {$i + 1}]]] || \
+ ![string is alpha [string index $html [expr {$i + 2}]]])) } {
# Output the < and continue with next character
ad_html_to_text_put_text output "<"
set last_tag_end [incr i]
@@ -900,13 +900,13 @@
}
h1 - h2 - h3 - h4 - h5 - h6 {
set output(p) 1
- if { [empty_string_p $slash] } {
+ if { $slash eq "" } {
ad_html_to_text_put_text output [string repeat "*" [string index $tagname 1]]
}
}
li {
set output(br) 1
- if { [empty_string_p $slash] } {
+ if { $slash eq "" } {
ad_html_to_text_put_text output "- "
}
}
@@ -918,14 +918,14 @@
}
a {
if { !$no_format_p } {
- if { [empty_string_p $slash]} {
+ if { $slash eq ""} {
if { [info exists attribute_array(href)] } {
if { [info exists attribute_array(title)] } {
set title ": '$attribute_array(title)'"
} else {
set title ""
}
- set href_no [expr [llength $href_urls] + 1]
+ set href_no [expr {[llength $href_urls] + 1}]
lappend href_urls "\[$href_no\] $attribute_array(href) "
lappend href_stack "\[$href_no$title\]"
} elseif { [info exists attribute_array(title)] } {
@@ -945,15 +945,15 @@
}
pre {
set output(p) 1
- if { [empty_string_p $slash] } {
+ if { $slash eq "" } {
incr output(pre)
} else {
incr output(pre) -1
}
}
blockquote {
set output(p) 1
- if { [empty_string_p $slash] } {
+ if { $slash eq "" } {
incr output(blockquote)
incr output(maxlen) -4
} else {
@@ -970,7 +970,7 @@
ad_html_to_text_put_text output \"
}
img {
- if { [empty_string_p $slash] && !$no_format_p } {
+ if { $slash eq "" && !$no_format_p } {
set img_info {}
if { [info exists attribute_array(alt)] } {
lappend img_info "'$attribute_array(alt)'"
@@ -1016,13 +1016,13 @@
# conversion like in ad_text_to_html
# 2006/09/12
set myChars {
- � � � � � � � � � �
- � � � � � � � � � �
- � � � � � � � � � �
- � � � � � � � � � �
- � � � � � � � � � �
- � � � � � � � � � �
- � � � � �
+ ª º À Á Â Ã Ä Å Æ Ç
+ È É Ê Ë Ì Í Î Ï Ð Ñ
+ Ò Ó Ô Õ Ö Ø Ù Ú Û Ü
+ Ý Þ ß à á â ã ä å æ
+ ç è é ê ë ì í î ï ð
+ ñ ò ó ô õ ö ø ù ú û
+ ü ý þ ÿ ¿
}
set myHTML {
@@ -1075,18 +1075,18 @@
regsub -all {\s+} $text { } text
# if there's only spaces in the string, wait until later
- if { [string equal $text " "] } {
+ if {$text eq " "} {
set output(space) 1
return
}
# if it's nothing, do nothing
- if { [empty_string_p $text] } {
+ if { $text eq "" } {
return
}
# if the first character is a space, set the space bit
- if { [string equal [string index $text 0] " "] } {
+ if {[string index $text 0] eq " "} {
set output(space) 1
set text [string trimleft $text]
}
@@ -1101,7 +1101,7 @@
# output any pending paragraph breaks, line breaks or spaces.
# as long as we're not at the beginning of the document
if { $output(p) || $output(br) || $output(space) } {
- if { ![empty_string_p $output(text)] } {
+ if { $output(text) ne "" } {
if { $output(p) } {
ad_html_to_text_put_newline output
ad_html_to_text_put_newline output
@@ -1127,7 +1127,7 @@
}
# If there's a blockquote in the beginning of the text, we wouldn't have caught it before
- if { [empty_string_p $output(text)] } {
+ if { $output(text) eq "" } {
append output(text) [string repeat { } $output(blockquote)]
}
@@ -1145,12 +1145,12 @@
incr output(linelen) $wordlen
}
"\n" {
- if { ![empty_string_p $output(text)] } {
+ if { $output(text) ne "" } {
ad_html_to_text_put_newline output
}
}
default {
- if { [expr $output(linelen) + $wordlen] > $output(maxlen) && $output(maxlen) != 0 } {
+ if { [expr {$output(linelen) + $wordlen}] > $output(maxlen) && $output(maxlen) != 0 } {
ad_html_to_text_put_newline output
}
append output(text) "$word"
@@ -1220,18 +1220,18 @@
{ set i [string first & $html $i] } {
set match_p 0
- switch -regexp -- [string index $html [expr $i+1]] {
+ switch -regexp -- [string index $html [expr {$i+1}]] {
# {
- switch -regexp -- [string index $html [expr $i+2]] {
+ switch -regexp -- [string index $html [expr {$i+2}]] {
[xX] {
- regexp -indices -start [expr $i+3] {[0-9a-fA-F]*} $html hex_idx
+ regexp -indices -start [expr {$i+3}] {[0-9a-fA-F]*} $html hex_idx
set hex [string range $html [lindex $hex_idx 0] [lindex $hex_idx 1]]
set html [string replace $html $i [lindex $hex_idx 1] \
[subst -nocommands -novariables "\\x$hex"]]
set match_p 1
}
[0-9] {
- regexp -indices -start [expr $i+2] {[0-9]*} $html dec_idx
+ regexp -indices -start [expr {$i+2}] {[0-9]*} $html dec_idx
set dec [string range $html [lindex $dec_idx 0] [lindex $dec_idx 1]]
set html [string replace $html $i [lindex $dec_idx 1] \
[format "%c" $dec]]
@@ -1240,7 +1240,7 @@
}
}
[a-zA-Z] {
- if { [regexp -indices -start [expr $i] {\A&([^\s;]+)} $html match entity_idx] } {
+ if { [regexp -indices -start [expr {$i}] {\A&([^\s;]+)} $html match entity_idx] } {
set entity [string tolower [string range $html [lindex $entity_idx 0] [lindex $entity_idx 1]]]
if { [info exists entities($entity)] } {
set html [string replace $html $i [lindex $match 1] $entities($entity)]
@@ -1275,18 +1275,18 @@
set result_rows [list]
set start_of_line_index 0
while 1 {
- set this_line [string range $input $start_of_line_index [expr $start_of_line_index + $threshold - 1]]
- if { $this_line == "" } {
+ set this_line [string range $input $start_of_line_index [expr {$start_of_line_index + $threshold - 1}]]
+ if { $this_line eq "" } {
return [join $result_rows "\n"]
}
set first_new_line_pos [string first "\n" $this_line]
if { $first_new_line_pos != -1 } {
# there is a newline
- lappend result_rows [string range $input $start_of_line_index [expr $start_of_line_index + $first_new_line_pos - 1]]
- set start_of_line_index [expr $start_of_line_index + $first_new_line_pos + 1]
+ lappend result_rows [string range $input $start_of_line_index [expr {$start_of_line_index + $first_new_line_pos - 1}]]
+ set start_of_line_index [expr {$start_of_line_index + $first_new_line_pos + 1}]
continue
}
- if { [expr $start_of_line_index + $threshold + 1] >= [string length $input] } {
+ if { [expr {$start_of_line_index + $threshold + 1}] >= [string length $input] } {
# we're on the last line and it is < threshold so just return it
lappend result_rows $this_line
return [join $result_rows "\n"]
@@ -1310,9 +1310,9 @@
}
}
# OK, we have a last space pos of some sort
- set real_index_of_space [expr $start_of_line_index + $last_space_pos]
- lappend result_rows [string range $input $start_of_line_index [expr $real_index_of_space - 1]]
- set start_of_line_index [expr $start_of_line_index + $last_space_pos + 1]
+ set real_index_of_space [expr {$start_of_line_index + $last_space_pos}]
+ lappend result_rows [string range $input $start_of_line_index [expr {$real_index_of_space - 1}]]
+ set start_of_line_index [expr {$start_of_line_index + $last_space_pos + 1}]
}
}
@@ -1394,7 +1394,7 @@
# text/html). Simplies things when providing confirmation pages
# for input destined for the content repository ...
- if { [empty_string_p $text] } {
+ if { $text eq "" } {
return ""
}
@@ -1516,7 +1516,7 @@
@author Lars Pind (lars@pinds.com)
@creation-date 19 July 2000
} {
- if { [string equal $html_p t] } {
+ if {$html_p eq "t"} {
set from html
} else {
set from text
@@ -1537,7 +1537,7 @@
@author Lars Pind (lars@pinds.com)
@creation-date 19 July 2000
} {
- if { [string equal $html_p t] } {
+ if {$html_p eq "t"} {
set from html
} else {
set from text
@@ -1616,7 +1616,7 @@
set end_index [expr $len-[string length $ellipsis]-1]
# Back up to the nearest whitespace
- if { ![string is space [string index $string [expr $end_index + 1]]] } {
+ if { ![string is space [string index $string [expr {$end_index + 1}]]] } {
while { $end_index >= 0 && ![string is space [string index $string $end_index]] } {
incr end_index -1
}
@@ -1693,7 +1693,7 @@
@see ad_convert_to_html
} {
- if { $html_p == "t" } {
+ if { $html_p eq "t" } {
return $raw_string
} else {
return [util_convert_plaintext_to_html $raw_string]
Index: openacs-4/packages/acs-tcl/tcl/user-extensions-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/user-extensions-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-tcl/tcl/user-extensions-procs.tcl 17 May 2003 10:04:18 -0000 1.4
+++ openacs-4/packages/acs-tcl/tcl/user-extensions-procs.tcl 10 Jan 2007 21:22:12 -0000 1.5
@@ -24,7 +24,7 @@
notified of changes in user information.
} {
- if {[empty_string_p $impl]} {
+ if {$impl eq ""} {
set extensions [list_extensions]
} else {
set extensions [list $impl]
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 -r1.92 -r1.93
--- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 15 Dec 2006 00:02:00 -0000 1.92
+++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 10 Jan 2007 21:22:12 -0000 1.93
@@ -27,7 +27,7 @@
proc_doc util_report_library_entry {{extra_message ""}} "Should be called at beginning of private Tcl library files so that it is easy to see in the error log whether or not private Tcl library files contain errors." {
set tentative_path [info script]
regsub -all {/\./} $tentative_path {/} scrubbed_path
- if { [string compare $extra_message ""] == 0 } {
+ if { $extra_message eq "" } {
set message "Loading $scrubbed_path"
} else {
set message "Loading $scrubbed_path; $extra_message"
@@ -65,7 +65,7 @@
}
# contributed by michael@cleverly.com
- if { [string match Vform_counter_i $name] } {
+ if { "Vform_counter_i" eq $name } {
error "Vform_counter_i not an allowed form variable"
}
@@ -102,7 +102,7 @@
# check to make sure path is to an authorized directory
set tmpdir_list [ad_parameter_all_values_as_list TmpDir]
- if { [empty_string_p $tmpdir_list] } {
+ if { $tmpdir_list eq "" } {
set tmpdir_list [list "/var/tmp" "/tmp"]
}
@@ -138,7 +138,7 @@
# the variable matched the pattern
set typed_var_type [lindex $typed_var_spec 1]
- if { [string match "" $typed_var_type] } {
+ if { "" eq $typed_var_type } {
# if they don't specify a type, the default is 'integer'
set typed_var_type integer
}
@@ -217,7 +217,7 @@
sensible error message to the user.
} {
if { [catch {
- if { ![empty_string_p $bind] } {
+ if { $bind ne "" } {
db_dml $statement_name $insert_dml -bind $bind
} else {
db_dml $statement_name $insert_dml
@@ -273,7 +273,7 @@
# was "8.0"
set trimmed_month [string trimleft $month 0]
- set pretty_month [lindex $allthemonths [expr $trimmed_month - 1]]
+ set pretty_month [lindex $allthemonths [expr {$trimmed_month - 1}]]
set trimmed_day [string trimleft $day 0]
@@ -289,7 +289,7 @@
set new_set_id [ns_set new "no_nulls$old_set_id"]
for {set i 0} {$i<[ns_set size $old_set_id]} {incr i} {
- if { [ns_set value $old_set_id $i] != "" } {
+ if { [ns_set value $old_set_id $i] ne "" } {
ns_set put $new_set_id [ns_set key $old_set_id $i] [ns_set value $old_set_id $i]
@@ -322,7 +322,7 @@
db_0or1row $statement_name $sql_qry -bind $bind -column_set set_id
- if { $set_id != "" } {
+ if { $set_id ne "" } {
for {set i 0} {$i<[ns_set size $set_id]} {incr i} {
set form [ns_formvalueput $form [ns_set key $set_id $i] [ns_set value $set_id $i]]
@@ -336,15 +336,15 @@
proc util_PrettyBoolean {t_or_f { default "default" } } {
- if { $t_or_f == "t" || $t_or_f == "T" } {
+ if { $t_or_f eq "t" || $t_or_f eq "T" } {
return "Yes"
- } elseif { $t_or_f == "f" || $t_or_f == "F" } {
+ } elseif { $t_or_f eq "f" || $t_or_f eq "F" } {
return "No"
} else {
# Note that we can't compare default to the empty string as in
# many cases, we are going want the default to be the empty
# string
- if { [string compare $default "default"] == 0 } {
+ if { $default eq "default" } {
return "Unknown (\"$t_or_f\")"
} else {
return $default
@@ -401,14 +401,14 @@
set select_options ""
- if { ![empty_string_p $bind] } {
+ if { $bind ne "" } {
set options [db_list $stmt_name $sql -bind $bind]
} else {
set options [db_list $stmt_name $sql]
}
foreach option $options {
- if { [string compare $option $select_option] == 0 } {
+ if { $option eq $select_option } {
append select_options "<option selected=\"selected\">$option</option>\n"
} else {
append select_options "<option>$option</option>\n"
@@ -438,7 +438,7 @@
} {
set select_options ""
- if { ![empty_string_p $bind] } {
+ if { $bind ne "" } {
set options [db_list_of_lists $stmt_name $sql -bind $bind]
} else {
set options [uplevel [list db_list_of_lists $stmt_name $sql]]
@@ -633,7 +633,7 @@
if { $entire_form_p } {
set the_form [ns_getform]
- if { ![empty_string_p $the_form] } {
+ if { $the_form ne "" } {
for { set i 0 } { $i < [ns_set size $the_form] } { incr i } {
set varname [ns_set key $the_form $i]
set varvalue [ns_set value $the_form $i]
@@ -667,7 +667,7 @@
return -code error "A varspec must have either one or two elements."
}
- if { ![string equal $precedence_type "noprocessing_vars"] } {
+ if { $precedence_type ne "noprocessing_vars" } {
# Hide escaped colons for below split
regsub -all {\\:} $var_spec "!!cOlOn!!" var_spec
@@ -688,7 +688,7 @@
set exp_precedence_type($name) $precedence_type
- if { ![string equal $precedence_type "exclude"] } {
+ if { $precedence_type ne "exclude" } {
set flags [split [lindex $name_spec 1] ","]
foreach flag $flags {
@@ -700,7 +700,7 @@
}
if { [llength $var_spec] > 1 } {
- if { ![string equal $precedence_type "noprocessing_vars"] } {
+ if { $precedence_type ne "noprocessing_vars" } {
set value [uplevel subst \{[lindex $var_spec 1]\}]
} else {
set value [lindex $var_spec 1]
@@ -715,7 +715,7 @@
# If the no_empty_p flag is set, remove empty string values first
set exp_value($name) [list]
foreach { key value } [array get upvar_variable] {
- if { ![empty_string_p $value] } {
+ if { $value ne "" } {
lappend exp_value($name) $key $value
}
}
@@ -736,13 +736,13 @@
# This is a list, remove empty entries
set exp_value($name) [list]
foreach elm $upvar_variable {
- if { ![empty_string_p $elm] } {
+ if { $elm ne "" } {
lappend exp_value($name) $elm
}
}
} else {
# Simple value, this is easy
- if { ![empty_string_p $upvar_variable] } {
+ if { $upvar_variable ne "" } {
set exp_value($name) $upvar_variable
}
}
@@ -765,7 +765,7 @@
set export_set [ns_set create]
foreach name [array names exp_precedence_type] {
- if { ![string equal $exp_precedence_type($name) "exclude"] } {
+ if { $exp_precedence_type($name) ne "exclude" } {
if { [info exists exp_value($name)] } {
if { [info exists exp_flag($name:array)] } {
if { [info exists exp_flag($name:multiple)] } {
@@ -833,7 +833,7 @@
# Prepend with the base URL
if { [exists_and_not_null base] } {
- if { ![empty_string_p $export_string] } {
+ if { $export_string ne "" } {
if { [regexp {\?} $base] } {
# The base already has query vars
set export_string "${base}&${export_string}"
@@ -1070,7 +1070,7 @@
} {
set hidden ""
set the_form [ns_getform]
- if { ![empty_string_p $the_form] } {
+ if { $the_form ne "" } {
for {set i 0} {$i<[ns_set size $the_form]} {incr i} {
set varname [ns_set key $the_form $i]
set varvalue [ns_set value $the_form $i]
@@ -1095,19 +1095,19 @@
@see export_vars
} {
- if { [empty_string_p $setid] } {
+ if { $setid eq "" } {
set setid [ns_getform]
}
set return_list [list]
- if { ![empty_string_p $setid] } {
+ if { $setid ne "" } {
set set_size [ns_set size $setid]
set set_counter_i 0
while { $set_counter_i<$set_size } {
set name [ns_set key $setid $set_counter_i]
set value [ns_set value $setid $set_counter_i]
- if {[lsearch $exclusion_list $name] == -1 && ![empty_string_p $name]} {
- if {$format == "url"} {
+ if {[lsearch $exclusion_list $name] == -1 && $name ne ""} {
+ if {$format eq "url"} {
lappend return_list "[ns_urlencode $name]=[ns_urlencode $value]"
} else {
lappend return_list " name=\"[ad_quotehtml $name]\" value=\"[ad_quotehtml $value]\""
@@ -1116,7 +1116,7 @@
incr set_counter_i
}
}
- if {$format == "url"} {
+ if {$format eq "url"} {
return [join $return_list "&"]
} else {
return "<input type=\"hidden\" [join $return_list " />\n <input type=\"hidden\" "] />"
@@ -1214,12 +1214,12 @@
} {
set params [list]
set the_form [ns_getform]
- if { ![empty_string_p $the_form] } {
+ if { $the_form ne "" } {
for {set i 0} {$i<[ns_set size $the_form]} {incr i} {
set varname [ns_set key $the_form $i]
set varvalue [ns_set value $the_form $i]
if {
- $vars_to_passthrough == "" ||
+ $vars_to_passthrough eq "" ||
([lsearch -exact $vars_to_passthrough $varname] != -1)
} {
lappend params "[ns_urlencode $varname]=[ns_urlencode $varvalue]"
@@ -1241,7 +1241,7 @@
set url [ad_conn url]
set query [ns_getform]
- if { $query != "" } {
+ if { $query ne "" } {
append url "?[export_entire_form_as_url_vars]"
}
@@ -1298,7 +1298,7 @@
set sublist_index 0
foreach sublist $list_of_lists {
set comparison_element [lindex $sublist $sublist_element_pos]
- if { [string compare $query_string $comparison_element] == 0 } {
+ if { $query_string eq $comparison_element } {
return $sublist_index
}
incr sublist_index
@@ -1317,7 +1317,7 @@
this means AOLserver may be sucking down a lot of bits that it
doesn't need.
} {
- if $use_get_p {
+ if {$use_get_p} {
set http [ns_httpopen GET $url "" $timeout]
} else {
set http [ns_httpopen HEAD $url "" $timeout]
@@ -1367,7 +1367,7 @@
Like ns_httpopen but works for POST as well; called by util_httppost
} {
- if { ![string match http://* $url] } {
+ if { ![string match "http://*" $url] } {
return -code error "Invalid url \"$url\": _httpopen only supports HTTP"
}
set url [split $url /]
@@ -1382,7 +1382,7 @@
if { [catch {
_ns_http_puts $timeout $wfd "$method $uri HTTP/1.0\r"
_ns_http_puts $timeout $wfd "Host: $host\r"
- if {$rqset != ""} {
+ if {$rqset ne ""} {
for {set i 0} {$i < [ns_set size $rqset]} {incr i} {
_ns_http_puts $timeout $wfd \
"[ns_set key $rqset $i]: [ns_set value $rqset $i]\r"
@@ -1451,19 +1451,19 @@
set status [lindex $response 1]
if {$status == 302} {
set location [ns_set iget $headers location]
- if {$location != ""} {
+ if {$location ne ""} {
ns_set free $headers
close $rfd
return [util_httpget $location {} $timeout $depth]
}
}
set length [ns_set iget $headers content-length]
- if { [string match "" $length] } {set length -1}
+ if { "" eq $length } {set length -1}
set err [catch {
while 1 {
set buf [_ns_http_read $timeout $rfd $length]
append page $buf
- if { [string match "" $buf] } break
+ if { "" eq $buf } break
if {$length > 0} {
incr length -[string length $buf]
if {$length <= 0} break
@@ -1472,7 +1472,7 @@
} errMsg]
ns_set free $headers
close $rfd
- if $err {
+ if {$err} {
global errorInfo
return -code error -errorinfo $errorInfo $errMsg
}
@@ -1487,7 +1487,7 @@
} {
set tentative_path [info script]
regsub -all {/\./} $tentative_path {/} scrubbed_path
- if { [string compare $extra_message ""] == 0 } {
+ if { $extra_message eq "" } {
set message "Done... $scrubbed_path"
} else {
set message "Done... $scrubbed_path; $extra_message"
@@ -1503,7 +1503,7 @@
(varname not $varname which will pass variable varnames value into this function).
} {
upvar 1 $varname var
- return [expr { [info exists var] && ![empty_string_p $var] }]
+ return [expr { [info exists var] && $var ne "" }]
}
ad_proc -public exists_and_equal { varname value } {
@@ -1516,7 +1516,7 @@
} {
upvar 1 $varname var
- return [expr { [info exists var] && [string equal $var $value] } ]
+ return [expr { [info exists var] && $var eq $value } ]
}
ad_proc -public ad_httpget {
@@ -1549,7 +1549,7 @@
if {$status == 302 || $status == 301} {
set location [ns_set iget $headers location]
- if {![empty_string_p $location]} {
+ if {$location ne ""} {
ns_set free $headers
close $rfd
return [ad_httpget -url $location -timeout $timeout -depth $depth]
@@ -1563,13 +1563,13 @@
close $rfd
} else {
set length [ns_set iget $headers content-length]
- if { [string match "" $length] } {set length -1}
+ if { "" eq $length } {set length -1}
set err [catch {
while 1 {
set buf [_ns_http_read $timeout $rfd $length]
append page $buf
- if { [string match "" $buf] } break
+ if { "" eq $buf } break
if {$length > 0} {
incr length -[string length $buf]
if {$length <= 0} break
@@ -1579,7 +1579,7 @@
ns_set free $headers
close $rfd
- if $err {
+ if {$err} {
global errorInfo
return -code error -errorinfo $errorInfo $errMsg
}
@@ -1627,7 +1627,7 @@
}
# trim leading zeros, so as not to confuse Tcl
set string [string trimleft $string "0"]
- if { [empty_string_p $string] } {
+ if { $string eq "" } {
# but not all of the zeros
return "0"
}
@@ -1642,7 +1642,7 @@
@see ad_page_contract
} {
- if { $country_code == "" || [string toupper $country_code] == "US" } {
+ if { $country_code eq "" || [string toupper $country_code] eq "US" } {
if { [regexp {^[0-9][0-9][0-9][0-9][0-9](-[0-9][0-9][0-9][0-9])?$} $zip_string] } {
set zip_5 [string range $zip_string 0 4]
if {
@@ -1660,7 +1660,7 @@
error "The entry for $field_name, \"$zip_string\" does not look like a zip code"
}
} else {
- if { $zip_string != "" } {
+ if { $zip_string ne "" } {
error "Zip code is not needed outside the US"
}
}
@@ -1687,7 +1687,7 @@
} else {
return ""
}
- } elseif { ![empty_string_p $year] && [string length $year] != 4 } {
+ } elseif { $year ne "" && [string length $year] != 4 } {
error "The year must contain 4 digits."
} elseif { [catch { ns_dbformvalue $form $column date date } errmsg ] } {
error "The entry for $field_name had a problem: $errmsg."
@@ -1727,7 +1727,7 @@
MIME-Version: 1.0
Content-Type: $content_type\r\n"
util_WriteWithExtraOutputHeaders $all_the_headers
- if {[string match text/* $content_type]} {
+ if {[string match "text/*" $content_type]} {
if {![string match *charset=* $content_type]} {
append content_type \
"; charset=[ns_config ns/parameters OutputCharset iso-8859-1]"
@@ -1791,7 +1791,7 @@
set counter 1
- while { $counter < [expr $num_args - 2] } {
+ while { $counter < [expr {$num_args - 2}] } {
lappend from_list [lindex $args $counter]
incr counter
lappend to_list [lindex $args $counter]
@@ -1828,7 +1828,7 @@
} {
Returns the value of a cookie, or $default if none exists.
} {
- if { $include_set_cookies == "t" } {
+ if { $include_set_cookies eq "t" } {
set headers [ad_conn outputheaders]
for { set i 0 } { $i < [ns_set size $headers] } { incr i } {
if { ![string compare [string tolower [ns_set key $headers $i]] "set-cookie"] && \
@@ -1845,7 +1845,7 @@
# If the cookie was set to a blank value we actually stored two quotes. We need
# to undo the kludge on the way out.
- if { $value == "\"\"" } {
+ if { $value eq "\"\"" } {
set value ""
}
return $value
@@ -1896,7 +1896,7 @@
@see ad_get_cookie
} {
set headers [ad_conn outputheaders]
- if { $replace != "f" } {
+ if { $replace ne "f" } {
# Try to find an already-set cookie named $name.
for { set i 0 } { $i < [ns_set size $headers] } { incr i } {
if { ![string compare [string tolower [ns_set key $headers $i]] "set-cookie"] && \
@@ -1907,35 +1907,35 @@
}
# need to set some value, so we put "" as the cookie value
- if { $value == "" } {
+ if { $value eq "" } {
set cookie "$name=\"\""
} else {
set cookie "$name=$value"
}
- if { $path != "" } {
+ if { $path ne "" } {
append cookie "; Path=$path"
}
- if { $max_age == "inf" } {
- if { ![string equal $expire "t"] } {
+ if { $max_age eq "inf" } {
+ if { $expire ne "t" } {
# netscape seemed unhappy with huge max-age, so we use
# expires which seems to work on both netscape and IE
append cookie "; Expires=Mon, 01-Jan-2035 01:00:00 GMT"
}
- } elseif { $max_age != "" } {
- append cookie "; Max-Age=$max_age; Expires=[util::cookietime [expr [ns_time] + $max_age]]"
+ } elseif { $max_age ne "" } {
+ append cookie "; Max-Age=$max_age; Expires=[util::cookietime [expr {[ns_time] + $max_age}]]"
}
- if { [string equal $expire "t"] } {
+ if {$expire eq "t"} {
append cookie "; Expires=Tue, 01-Jan-1980 01:00:00 GMT"
}
- if { $domain != "" } {
+ if { $domain ne "" } {
append cookie "; Domain=$domain"
}
- if { $secure != "f" } {
+ if { $secure ne "f" } {
append cookie "; Secure"
}
@@ -1977,7 +1977,7 @@
}
}
- if { $once == "f" } {
+ if { $once eq "f" } {
# The proc will run again - readd it to the shared variable (updating ns_time and
# incrementing the count).
lappend procs [list $thread $once $interval $proc $args [ns_time] [expr { $count + 1 }] $debug]
@@ -2030,7 +2030,7 @@
} {
# we don't schedule a proc to run if we have enabled server clustering,
# we're not the canonical server, and the procedure was not requested to run on all servers.
- if { [server_cluster_enabled_p] && ![ad_canonical_server_p] && $all_servers == "f" } {
+ if { [server_cluster_enabled_p] && ![ad_canonical_server_p] && $all_servers eq "f" } {
return
}
@@ -2046,16 +2046,16 @@
ns_mutex unlock [nsv_get ad_procs mutex]
set my_args [list]
- if { $thread == "t" } {
+ if { $thread eq "t" } {
lappend my_args "-thread"
}
- if { $once == "t" } {
+ if { $once eq "t" } {
lappend my_args "-once"
}
# Schedule the wrapper procedure (ad_run_scheduled_proc).
- if { [empty_string_p $schedule_proc] } {
+ if { $schedule_proc eq "" } {
eval [concat [list ns_schedule_proc] $my_args [list $interval ad_run_scheduled_proc [list $proc_info]]]
} else {
eval [concat [list $schedule_proc] $my_args $interval [list ad_run_scheduled_proc [list $proc_info]]]
@@ -2098,26 +2098,26 @@
for { set i 0 } { $i < [llength $excluded_vars] } { incr i } {
set item [lindex [lindex $excluded_vars $i] 0]
set value [lindex [lindex $excluded_vars $i] 1]
- if { [empty_string_p $value] } {
+ if { $value eq "" } {
# Obtain value from adp level
upvar #[template::adp_level] __item item_reference
set item_reference $item
upvar #[template::adp_level] __value value_reference
- uplevel #[template::adp_level] {set __value [expr $$__item]}
+ uplevel #[template::adp_level] {set __value [expr {$$__item}]}
set value $value_reference
}
lappend excluded_vars_list $item
- if { ![empty_string_p $value] } {
+ if { $value ne "" } {
# Value provided
- if { ![empty_string_p $excluded_vars_url] } {
+ if { $excluded_vars_url ne "" } {
append excluded_vars_url "&"
}
append excluded_vars_url [export_vars -url [list [list "$item" "$value"]]]
}
}
set saved_list ""
- if { ![empty_string_p $vars] } {
+ if { $vars ne "" } {
foreach item_value [split $vars "&"] {
set item_value_pair [split $item_value "="]
set item [lindex $item_value_pair 0]
@@ -2189,7 +2189,7 @@
set url [util_current_location]$target_url
} else {
# URL is relative to current directory.
- if {[string equal $target_url "."]} {
+ if {$target_url eq "."} {
set url [util_current_location][util_current_directory]
} else {
set url [util_current_location][util_current_directory]$target_url
@@ -2227,7 +2227,7 @@
@see util_get_user_messages
} {
- if { ![empty_string_p $message] } {
+ if { $message ne "" } {
if { [string is false $html_p] } {
set message [ad_quotehtml $message]
}
@@ -2259,7 +2259,7 @@
@see util_user_message
} {
set messages [ad_get_client_property -default {} -cache_only t "acs-kernel" "general_messages"]
- if { !$keep_p && ![empty_string_p $messages] } {
+ if { !$keep_p && $messages ne "" } {
ad_set_client_property "acs-kernel" "general_messages" {}
}
template::multirow create $multirow message
@@ -2284,7 +2284,7 @@
Check whether the path begins with a slash
} {
set firstchar [string index $path 0]
- if {[string compare $firstchar /]} {
+ if {$firstchar ne "/" } {
return 0
} else {
return 1
@@ -2302,7 +2302,7 @@
} {
upvar $array result
- if {[string equal $driver ""]} {
+ if {$driver eq ""} {
set driver [ad_conn driver]
}
@@ -2366,17 +2366,17 @@
ns_log Error "util_current_location couldn't regexp '[ad_conn location]'"
}
- if { [empty_string_p $Host] } {
+ if { $Host eq "" } {
# No Host header, return protocol from driver, hostname from [ad_conn location], and port from driver
set hostname $location_hostname
} else {
set hostname $Host_hostname
- if { ![empty_string_p $Host_port] } {
+ if { $Host_port ne "" } {
set port $Host_port
}
}
- if { ![empty_string_p $port] && ![string equal $port $default_port($proto)] } {
+ if { $port ne "" && $port ne $default_port($proto) } {
return "$proto://$hostname:$port"
} else {
return "$proto://$hostname"
@@ -2395,13 +2395,13 @@
} {
set path [ad_conn url]
- set lastchar [string range $path [expr [string length $path]-1] end]
- if {![string compare $lastchar /]} {
+ set lastchar [string range $path [expr {[string length $path]-1}] end]
+ if {$lastchar eq "/" } {
return $path
} else {
set file_dirname [file dirname $path]
# Treat the case of the root directory special
- if {![string compare $file_dirname /]} {
+ if {$file_dirname eq "/" } {
return /
} else {
return $file_dirname/
@@ -2433,7 +2433,7 @@
@see ad_print_stack_trace
} {
set stack ""
- for { set x [expr [info level] + $level] } { $x > 0 } { incr x -1 } {
+ for { set x [expr {[info level] + $level}] } { $x > 0 } { incr x -1 } {
append stack " called from [info level $x]\n"
}
return $stack
@@ -2574,7 +2574,7 @@
set sorted_list2 [lsort $list2]
for { set index1 0 } { $index1 < [llength $sorted_list1] } { incr index1 } {
- if { ![string equal [lindex $sorted_list1 $index1] [lindex $sorted_list2 $index1]] } {
+ if { [lindex $sorted_list1 $index1] ne [lindex $sorted_list2 $index1] } {
return 0
}
}
@@ -2660,7 +2660,7 @@
set sorted_list1 [list]
foreach elm [lsort $list1] {
- if { [llength $sorted_list1] == 0 || ![string equal [lindex $sorted_list1 end] $elm] } {
+ if { [llength $sorted_list1] == 0 || [lindex $sorted_list1 end] ne $elm } {
lappend sorted_list1 $elm
}
}
@@ -2851,7 +2851,7 @@
@author Tilmann Singer
} {
- if { [empty_string_p $text] } {
+ if { $text eq "" } {
set text $_text
}
@@ -2871,7 +2871,7 @@
set text [string trim $text $replacement]
# throw an error when the resulting string is empty
- if { [empty_string_p $text] } {
+ if { $text eq "" } {
error "Cannot compute a URL of this string: \"$original_text\" because after removing all illegal characters it's an empty string."
}
@@ -2898,7 +2898,7 @@
if { [regexp "${text}${replacement}(\\d+)\$" $url match n] } {
# matches the foo-123 pattern
- if { $n >= $number } { set number [expr $n + 1] }
+ if { $n >= $number } { set number [expr {$n + 1}] }
}
}
@@ -3066,7 +3066,7 @@
set sorted_list2 [lsort $list2]
for { set index1 0 } { $index1 < [llength $sorted_list1] } { incr index1 } {
- if { ![string equal [lindex $sorted_list1 $index1] [lindex $sorted_list2 $index1]] } {
+ if { [lindex $sorted_list1 $index1] ne [lindex $sorted_list2 $index1] } {
return 0
}
}
@@ -3180,7 +3180,7 @@
set filename [file tail $file]
}
- if {[string equal */* $mime_type] || [empty_string_p $mime_type]} {
+ if {[string equal */* $mime_type] || $mime_type eq ""} {
set mime_type [ns_guesstype $file]
}
}
@@ -3197,10 +3197,10 @@
error "Cannot upload file without specifing -filename"
}
- if {[string equal $mime_type */*] || [empty_string_p $mime_type]} {
+ if {[string equal $mime_type */*] || $mime_type eq ""} {
set mime_type [ns_guesstype $filename]
- if {[string equal $mime_type */*] || [empty_string_p $mime_type]} {
+ if {[string equal $mime_type */*] || $mime_type eq ""} {
set mime_type application/octet-stream
}
}
@@ -3299,12 +3299,12 @@
set response [ns_set name $headers]
set status [lindex $response 1]
set length [ns_set iget $headers content-length]
- if { [string match "" $length] } { set length -1 }
+ if { "" eq $length } { set length -1 }
set err [catch {
while 1 {
set buf [_ns_http_read $timeout $rfd $length]
append page $buf
- if { [string match "" $buf] } break
+ if { "" eq $buf } break
if {$length > 0} {
incr length -[string length $buf]
if {$length <= 0} break
@@ -3315,7 +3315,7 @@
ns_set free $headers
close $rfd
- if $err {
+ if {$err} {
global errorInfo
return -code error -errorinfo $errorInfo $errMsg
}
@@ -3408,14 +3408,14 @@
foreach element_name $path {
set current_node [xml_node_get_first_child_by_name $current_node $element_name]
- if { [empty_string_p $current_node] } {
+ if { $current_node eq "" } {
# Try the next path
break
}
}
- if { ![empty_string_p $current_node] } {
+ if { $current_node ne "" } {
set result [xml_node_get_content $current_node]
- if { ![empty_string_p $result] } {
+ if { $result ne "" } {
# Found the value, we're done
break
}
@@ -3477,13 +3477,13 @@
set current_node $node
foreach element_name $path_list {
set current_node [xml_node_get_first_child_by_name $current_node $element_name]
- if { [empty_string_p $current_node] } {
+ if { $current_node eq "" } {
# Try the next path
break
}
}
- if { ![empty_string_p $current_node] } {
+ if { $current_node ne "" } {
set attribute [xml_node_get_attribute $current_node $attribute_name ""]
}
@@ -3679,7 +3679,7 @@
@see ad_page_contract
} {
set form [ns_getform]
- if { [empty_string_p $form] } { return filter_ok }
+ if { $form eq "" } { return filter_ok }
# Check each form data variable to see if it contains malicious
# user input that we don't want to interpolate into our SQL
@@ -4049,10 +4049,10 @@
} {
set output {}
foreach { elm val } $list {
- if { [llength $val] > 1 && [expr [llength $val] % 2] == 0 } {
+ if { [llength $val] > 1 && [expr {[llength $val] % 2}] == 0 } {
append output [string repeat " " $indent] "$elm \{" \n
- append output [util::array_list_spec_pretty $val [expr $indent + 4]]
+ append output [util::array_list_spec_pretty $val [expr {$indent + 4}]]
append output [string repeat " " $indent] \} \n
} else {
@@ -4069,9 +4069,9 @@
} {
set result {}
if { $seconds > 0 } {
- set hrs [expr $seconds / (60*60)]
+ set hrs [expr {$seconds / (60*60)}]
set mins [expr ($seconds / 60) % 60]
- set secs [expr $seconds % 60]
+ set secs [expr {$seconds % 60}]
if { $hrs > 0 } { append result "${hrs}h " }
if { $hrs > 0 || $mins > 0 } { append result "${mins}m " }
append result "${secs}s"
@@ -4115,17 +4115,17 @@
@param locale If present, overrides the default locale
@return Interval between timestamp and sysdate, as localized text string.
} {
- set age_seconds [expr [clock scan $sysdate_ansi] - [clock scan $timestamp_ansi]]
+ set age_seconds [expr {[clock scan $sysdate_ansi] - [clock scan $timestamp_ansi]}]
if { $age_seconds < 30 } {
# Handle with normal processing below -- otherwise this would require another string to localize
set age_seconds 60
}
- if { $age_seconds < [expr $hours_limit * 60 * 60] } {
- set hours [expr abs($age_seconds / 3600)]
- set minutes [expr round(($age_seconds% 3600)/60.0)]
- if {[expr $hours < 24]} {
+ if { $age_seconds < [expr {$hours_limit * 60 * 60}] } {
+ set hours [expr {abs($age_seconds / 3600)}]
+ set minutes [expr {round(($age_seconds% 3600)/60.0)}]
+ if {[expr {$hours < 24}]} {
switch $hours {
0 { set result "" }
1 { set result "One hour " }
@@ -4137,15 +4137,15 @@
default { append result "$minutes minutes " }
}
} else {
- set days [expr abs($hours / 24)]
+ set days [expr {abs($hours / 24)}]
switch $days {
1 { set result "One day " }
default { set result "$days days "}
}
}
append result "ago"
- } elseif { $age_seconds < [expr $days_limit * 60 * 60 * 24] } {
+ } elseif { $age_seconds < [expr {$days_limit * 60 * 60 * 24}] } {
set result [lc_time_fmt $timestamp_ansi $mode_2_fmt $locale]
} else {
set result [lc_time_fmt $timestamp_ansi $mode_3_fmt $locale]
@@ -4190,7 +4190,7 @@
@author Gabriel Burca
} {
- if {$filter_proc != ""} {
+ if {$filter_proc ne ""} {
set old [$filter_proc $old]
set new [$filter_proc $new]
}
@@ -4219,16 +4219,16 @@
while {![eof $diff_pipe]} {
gets $diff_pipe diff
if {[regexp {^d(\d+)(\s+(\d+))?$} $diff full m1 m2]} {
- if {$m2 != ""} {set d_end $m2} else {set d_end $m1}
+ if {$m2 ne ""} {set d_end $m2} else {set d_end $m1}
for {set i $sv} {$i < $m1} {incr i} {
append res "${split_by}[lindex $old_w $i]"
}
for {set i $m1} {$i <= $d_end} {incr i} {
append res "${split_by}${start_old}[lindex $old_w $i]${end_old}"
}
- set sv [expr $d_end + 1]
+ set sv [expr {$d_end + 1}]
} elseif {[regexp {^c(\d+)(\s+(\d+))?$} $diff full m1 m2]} {
- if {$m2 != ""} {set d_end $m2} else {set d_end $m1}
+ if {$m2 ne ""} {set d_end $m2} else {set d_end $m1}
for {set i $sv} {$i < $m1} {incr i} {
append res "${split_by}[lindex $old_w $i]"
}
@@ -4237,27 +4237,27 @@
}
while {![eof $diff_pipe]} {
gets $diff_pipe diff
- if {$diff == "."} {
+ if {$diff eq "."} {
break
} else {
append res "${split_by}${start_new}${diff}${end_new}"
}
}
- set sv [expr $d_end + 1]
+ set sv [expr {$d_end + 1}]
} elseif {[regexp {^a(\d+)$} $diff full m1]} {
set d_end $m1
for {set i $sv} {$i < $m1} {incr i} {
append res "${split_by}[lindex $old_w $i]"
}
while {![eof $diff_pipe]} {
gets $diff_pipe diff
- if {$diff == "."} {
+ if {$diff eq "."} {
break
} else {
append res "${split_by}${start_new}${diff}${end_new}"
}
}
- set sv [expr $d_end + 1]
+ set sv [expr {$d_end + 1}]
}
}
@@ -4348,7 +4348,7 @@
# Remember that we've examined the file.
set examined_files($file) 1
- if { [empty_string_p $check_file_func] || [eval [list $check_file_func $file]] } {
+ if { $check_file_func eq "" || [eval [list $check_file_func $file]] } {
# If it's a file, add to our list. If it's a
# directory, add its contents to our list of files to
# examine next time.
Index: openacs-4/packages/acs-tcl/tcl/whos-online-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/whos-online-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-tcl/tcl/whos-online-procs.tcl 8 Jan 2004 09:53:48 -0000 1.3
+++ openacs-4/packages/acs-tcl/tcl/whos-online-procs.tcl 10 Jan 2007 21:22:12 -0000 1.4
@@ -34,7 +34,7 @@
array set last_hit [nsv_array get last_hit]
set onliners_out [list]
set interval 1
- set oldtime [expr [ns_time] - [interval]]
+ set oldtime [expr {[ns_time] - [interval]}]
for { set search [array startsearch last_hit] } { [array anymore last_hit $search] } {} {
set user [array nextelement last_hit $search]
@@ -91,7 +91,7 @@
@author Peter Marklund
} {
if { [nsv_exists last_hit $user_id] } {
- return [expr [ns_time] - [nsv_get last_hit $user_id]]
+ return [expr {[ns_time] - [nsv_get last_hit $user_id]}]
} else {
return {}
}
@@ -104,7 +104,7 @@
@author Peter Marklund
} {
if { [nsv_exists last_hit $user_id] } {
- return [expr [ns_time] - [nsv_get first_hit $user_id]]
+ return [expr {[ns_time] - [nsv_get first_hit $user_id]}]
} else {
return {}
}
@@ -136,7 +136,7 @@
} {
array set last_hit [nsv_array get last_hit]
set onliners [list]
- set oldtime [expr [ns_time] - [interval]]
+ set oldtime [expr {[ns_time] - [interval]}]
for { set search [array startsearch last_hit] } { [array anymore last_hit $search] } {} {
set user_id [array nextelement last_hit $search]
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 -r1.7 -r1.8
--- openacs-4/packages/acs-tcl/tcl/widgets-procs.tcl 24 Feb 2004 11:20:01 -0000 1.7
+++ openacs-4/packages/acs-tcl/tcl/widgets-procs.tcl 10 Jan 2007 21:22:12 -0000 1.8
@@ -7,7 +7,7 @@
proc_doc state_widget { {default ""} {select_name "usps_abbrev"}} "Returns a state selection box" {
set widget_value "<select name=\"$select_name\">\n"
- if { $default == "" } {
+ if { $default eq "" } {
append widget_value "<option value=\"\" selected=\"selected\">Choose a State</option>\n"
}
@@ -27,7 +27,7 @@
proc_doc country_widget { {default ""} {select_name "country_code"} {size_subtag "size=4"}} "Returns a country selection box" {
set widget_value "<select name=\"$select_name\" $size_subtag>\n"
- if { $default == "" } {
+ if { $default eq "" } {
if { [ad_parameter SomeAmericanReadersP] } {
append widget_value "<option value=\"\">Choose a Country</option>
<option value=\"us\" selected=\"selected\">United States</option>\n"
@@ -59,7 +59,7 @@
set count 0
set return_string ""
foreach value $values {
- if { [string compare $default $value] == 0 } {
+ if { $default eq $value } {
append return_string "<option selected=\"selected\" value=\"$value\">[lindex $items $count]</option>\n"
} else {
append return_string "<option value=\"$value\">[lindex $items $count]</option>\n"
@@ -140,7 +140,7 @@
}
set date_parts [split $value "-"]
- if { $value == "" } {
+ if { $value eq "" } {
set month ""
set day ""
set year ""
@@ -156,7 +156,7 @@
# take care of cases like 09 for month
regsub "^0" $month "" month
for {set i 0} {$i < 12} {incr i} {
- if { $i == [expr $month - 1] } {
+ if { $i == [expr {$month - 1}] } {
append output "<option selected=\"selected\"> [lindex $NS(months) $i]</option>\n"
} else {
append output "<option>[lindex $NS(months) $i]</option>\n"
@@ -201,12 +201,12 @@
set retval {}
set count 0
set dbcount 0
- if {![empty_string_p $option_list]} {
+ if {$option_list ne ""} {
foreach opt $option_list {
incr count
set item [lindex $opt 1]
set value [lindex $opt 0]
- if { (!$multiple && [string compare $value $default] == 0)
+ if { (!$multiple && $value eq $default )
|| ($multiple && [lsearch -exact $default $value] > -1)} {
append retval "<option selected value=\"$value\">$item</option>\n"
} else {
@@ -219,22 +219,22 @@
set count 0
}
- if {! [empty_string_p $sql_qry]} {
+ if {$sql_qry ne ""} {
set columns [ns_set create]
db_foreach $statement_name $sql_qry -column_set selection -bind $bind {
incr count
incr dbcount
set item [ns_set value $selection 0]
set value [ns_set value $selection 1]
- if { (!$multiple && [string compare $value $default] == 0)
+ if { (!$multiple && $value eq $default )
|| ($multiple && [lsearch -exact $default $value] > -1)} {
append retval "<option selected=\"selected\" value=\"$value\">$item</option>\n"
} else {
append retval "<option value=\"$value\">$item</option>\n"
}
} if_no_rows {
- if {![empty_string_p $default]} {
+ if {$default ne ""} {
return "<input type=\"hidden\" value=\"[philg_quote_double_quotes $default]\" name=\"$name\" />\n"
} else {
return {}
@@ -261,7 +261,7 @@
proc_doc currency_widget {{default ""} {select_name "currency_code"} {size_subtag "size=\"4\""}} "Returns a currency selection box" {
set widget_value "<select name=\"$select_name\" $size_subtag>\n"
- if { $default == "" } {
+ if { $default eq "" } {
if { [ad_parameter SomeAmericanReadersP] } {
append widget_value "<option value=\"\">Currency</option>
<option value=\"USD\" selected=\"selected\">United States Dollar</option>\n"
@@ -399,7 +399,7 @@
}
if { $use_js == 1 } {
- if { $c1 == "" } {
+ if { $c1 eq "" } {
set c1 255
set c2 255
set c3 255
@@ -414,7 +414,7 @@
foreach field $args {
upvar $field var
set var [ns_queryget "$field.list"]
- if { $var == "custom" } {
+ if { $var eq "custom" } {
set var "[ns_queryget "$field.c1"],[ns_queryget "$field.c2"],[ns_queryget "$field.c3"]"
}
if { ![regexp {^([0-9]+),([0-9]+),([0-9]+)$} $var "" r g b] || $r > 255 || $g > 255 || $b > 255 } {
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 -r1.2 -r1.3
--- openacs-4/packages/acs-tcl/tcl/xml-0-sgml-procs.tcl 26 Jan 2004 15:39:46 -0000 1.2
+++ openacs-4/packages/acs-tcl/tcl/xml-0-sgml-procs.tcl 10 Jan 2007 21:22:12 -0000 1.3
@@ -389,7 +389,7 @@
# Get the version number
if {[regexp {[ ]*version="(-+|[a-zA-Z0-9_.:]+)"[ ]*} $param discard version] || [regexp {[ ]*version='(-+|[a-zA-Z0-9_.:]+)'[ ]*} $param discard version]} {
- if {[string compare $version "1.0"]} {
+ if {$version ne "1.0" } {
# Should we support future versions?
# At least 1.X?
uplevel #0 $options(-errorcommand) "document XML version \"$version\" is incompatible with XML version 1.0"
@@ -605,7 +605,7 @@
# Parse attribute list into a key-value representation
if {[string compare $options(-parseattributelistcommand) {}]} {
if {[catch {uplevel #0 $options(-parseattributelistcommand) [list $attr]} attr]} {
- if {[string compare [lindex $attr 0] "unterminated attribute value"]} {
+ if {[lindex $attr 0] ne "unterminated attribute value" } {
uplevel #0 $options(-errorcommand) [list $attr around line $state(line)]
set attr {}
} else {
@@ -682,7 +682,7 @@
array set cfg $args
# WF check
- if {[string compare $tag [lindex $state(stack) end]]} {
+ if {$tag ne [lindex $state(stack) end] } {
uplevel #0 $options(-errorcommand) [list "end tag \"$tag\" does not match open element \"[lindex $state(stack) end]\" around line $state(line)"]
return
}
@@ -1047,7 +1047,7 @@
}
start=| -
start=, {
- set var(state) [lreplace $var(state) end end [expr {$cs == "," ? ":seq" : ":choice"}]]
+ set var(state) [lreplace $var(state) end end [expr {$cs eq "," ? ":seq" : ":choice"}]]
CModelSTcsSet $state $cs
CModelSTcpAdd $state $cp $rep
}
@@ -1057,7 +1057,7 @@
}
:choice=, -
:seq=| {
- return -code error "syntax error in specification: incorrect delimiter after \"$cp\", should be \"[expr {$cs == "," ? "|" : ","}]\""
+ return -code error "syntax error in specification: incorrect delimiter after \"$cp\", should be \"[expr {$cs eq "," ? "|" : ","}]\""
}
end=* {
return -code error "syntax error in specification: no delimiter before \"$cp\""
@@ -1083,7 +1083,7 @@
proc sgml::CModelSTcsSet {state cs} {
upvar #0 $state var
- set cs [expr {$cs == "," ? ":seq" : ":choice"}]
+ set cs [expr {$cs eq "," ? ":seq" : ":choice"}]
if {[llength $var(stack)]} {
set var(stack) [lreplace $var(stack) end end $cs]
@@ -1279,9 +1279,9 @@
:seq {
for {set i 1} {$i < [llength [lindex $st 1]]} {incr i} {
followpos $state [lindex [lindex $st 1] $i] \
- [lindex [lindex $firstpos 0] [expr $i - 1]] \
- [lindex [lindex $lastpos 0] [expr $i - 1]]
- foreach pos [lindex [lindex [lindex $lastpos 0] [expr $i - 1]] 1] {
+ [lindex [lindex $firstpos 0] [expr {$i - 1}]] \
+ [lindex [lindex $lastpos 0] [expr {$i - 1}]]
+ foreach pos [lindex [lindex [lindex $lastpos 0] [expr {$i - 1}]] 1] {
eval lappend var($pos) [lindex [lindex [lindex $firstpos 0] $i] 1]
set var($pos) [makeSet $var($pos)]
}
@@ -1290,8 +1290,8 @@
:choice {
for {set i 1} {$i < [llength [lindex $st 1]]} {incr i} {
followpos $state [lindex [lindex $st 1] $i] \
- [lindex [lindex $firstpos 0] [expr $i - 1]] \
- [lindex [lindex $lastpos 0] [expr $i - 1]]
+ [lindex [lindex $firstpos 0] [expr {$i - 1}]] \
+ [lindex [lindex $lastpos 0] [expr {$i - 1}]]
}
}
default {
@@ -1380,7 +1380,7 @@
set result [lindex [lindex $firstpos 0] 1]
for {set i 0} {$i < [llength $nullable]} {incr i} {
if {[lindex [lindex $nullable $i] 1]} {
- eval lappend result [lindex [lindex $firstpos [expr $i + 1]] 1]
+ eval lappend result [lindex [lindex $firstpos [expr {$i + 1}]] 1]
} else {
break
}
@@ -1413,7 +1413,7 @@
switch -- $cs {
:seq {
set result [lindex [lindex $lastpos end] 1]
- for {set i [expr [llength $nullable] - 1]} {$i >= 0} {incr i -1} {
+ for {set i [expr {[llength $nullable] - 1}]} {$i >= 0} {incr i -1} {
if {[lindex [lindex $nullable $i] 1]} {
eval lappend result [lindex [lindex $lastpos $i] 1]
} else {
@@ -1483,13 +1483,13 @@
:choice {
set result 0
foreach child $subtree {
- set result [expr $result || [lindex $child 1]]
+ set result [expr {$result || [lindex $child 1]}]
}
}
:seq {
set result 1
foreach child $subtree {
- set result [expr $result && [lindex $child 1]]
+ set result [expr {$result && [lindex $child 1]}]
}
}
}
@@ -1581,7 +1581,7 @@
upvar opts state
upvar entities ents
- if {[string compare % $id]} {
+ if {"%" ne $id } {
# Entity declaration
if {[info exists ents($id)]} {
eval $state(-errorcommand) entity [list "entity \"$id\" already declared"]
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 -r1.2 -r1.3
--- openacs-4/packages/acs-tcl/tcl/xml-1-dom-procs.tcl 13 Sep 2002 11:10:33 -0000 1.2
+++ openacs-4/packages/acs-tcl/tcl/xml-1-dom-procs.tcl 10 Jan 2007 21:22:12 -0000 1.3
@@ -78,7 +78,7 @@
array set data [set $token]
# Type checking not implemented
-# if {[string compare $data(node:nodeType) "document"]} {
+# if {$data(node:nodeType) ne "document" } {
# return -code error "node is not of type document"
# }
@@ -142,7 +142,7 @@
# Later on, could use Tcl package facility
if {[regexp {create|destroy|parse|serialize|trim} [lindex $args 0]]} {
- if {![string compare [lindex $args 1] "1.0"]} {
+ if {[lindex $args 1] eq "1.0" } {
return 1
} else {
return 0
@@ -394,7 +394,7 @@
configure {
if {[llength $args] == 1} {
return [document cget $token [lindex $args 0]]
- } elseif {[expr [llength $args] % 2]} {
+ } elseif {[expr {[llength $args] % 2}]} {
return -code error "no value specified for option \"[lindex $args end]\""
} else {
foreach {option value} $args {
@@ -560,7 +560,7 @@
if {[string length $token]} {
- if {![string compare $parent(node:nodeType) documentFragment]} {
+ if {$parent(node:nodeType) eq "documentFragment" } {
if {$parent(id) == $parent(documentFragment:masterDoc)} {
if {[info exists parent(document:documentElement)] && \
[string length $parent(document:documentElement)]} {
@@ -571,7 +571,7 @@
# Check against document type decl
if {[string length $parent(document:doctype)]} {
array set doctypedecl [set $parent(document:doctype)]
- if {[string compare $name $doctypedecl(doctype:name)]} {
+ if {$name ne $doctypedecl(doctype:name) } {
return -code error "mismatch between root element type in document type declaration \"$doctypedecl(doctype:name)\" and root element \"$name\""
}
@@ -845,7 +845,7 @@
}
}
attributes {
- if {[string compare $node(node:nodeType) element]} {
+ if {$node(node:nodeType) ne "element" } {
set result {}
} else {
set result $node(element:attributeList)
@@ -866,7 +866,7 @@
if {[llength $args] == 1} {
return [document cget $token [lindex $args 0]]
- } elseif {[expr [llength $args] % 2]} {
+ } elseif {[expr {[llength $args] % 2}]} {
return -code error "no value specified for option \"[lindex $args end]\""
} else {
foreach {option value} $args {
@@ -893,7 +893,7 @@
}
GetHandle node [lindex $args 0] newChild
- if {[string compare $newChild(docArray) $node(docArray)]} {
+ if {$newChild(docArray) ne $node(docArray) } {
return -code error "new node must be in the same document"
}
@@ -909,7 +909,7 @@
2 {
GetHandle node [lindex $args 1] refChild
- if {[string compare $refChild(docArray) $newChild(docArray)]} {
+ if {$refChild(docArray) ne $newChild(docArray) } {
return -code error "nodes must be in the same document"
}
set idx [lsearch [set $node(node:childNodes)] [lindex $args 1]]
@@ -1204,7 +1204,7 @@
configure {
if {[llength $args] == 1} {
return [document cget $token [lindex $args 0]]
- } elseif {[expr [llength $args] % 2]} {
+ } elseif {[expr {[llength $args] % 2}]} {
return -code error "no value specified for option \"[lindex $args end]\""
} else {
foreach {option value} $args {
@@ -1304,20 +1304,20 @@
set result {}
- if {[string compare $node(node:nodeType) "documentFragment"]} {
+ if {$node(node:nodeType) ne "documentFragment" } {
foreach child [set $node(node:childNodes)] {
catch {unset childNode}
array set childNode [set $child]
- if {![string compare $childNode(node:nodeType) element] && \
- ![string compare [GetField childNode(node:nodeName)] $name]} {
+ if {$childNode(node:nodeType) eq "element" && \
+ [GetField childNode(node:nodeName)] eq $name } {
lappend result $child
}
}
} elseif {[llength $node(document:documentElement)]} {
# Document Element must exist and must be an element type node
catch {unset childNode}
array set childNode [set $node(document:documentElement)]
- if {![string compare $childNode(node:nodeName) $name]} {
+ if {$childNode(node:nodeName) eq $name } {
set result $node(document:documentElement)
}
}
@@ -1438,7 +1438,7 @@
configure {
if {[llength $args] == 1} {
return [document cget $token [lindex $args 0]]
- } elseif {[expr [llength $args] % 2]} {
+ } elseif {[expr {[llength $args] % 2}]} {
return -code error "no value specified for option \"[lindex $args end]\""
} else {
foreach {option value} $args {
@@ -1491,10 +1491,10 @@
proc dom::Serialize:documentFragment {token args} {
array set node [set $token]
- if {[string compare "node1" $node(documentFragment:masterDoc)]} {
+ if {"node1" ne $node(documentFragment:masterDoc) } {
return [eval [list Serialize:node $token] $args]
} else {
- if {[string compare {} [GetField node(document:documentElement)]]} {
+ if {{} ne [GetField node(document:documentElement)] } {
return [eval Serialize:document [list $token] $args]
} else {
return -code error "document has no document element"
Index: openacs-4/packages/acs-tcl/tcl/xml-2-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/xml-2-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-tcl/tcl/xml-2-procs.tcl 13 Mar 2001 22:59:27 -0000 1.1
+++ openacs-4/packages/acs-tcl/tcl/xml-2-procs.tcl 10 Jan 2007 21:22:12 -0000 1.2
@@ -209,7 +209,7 @@
variable substExpr
set parent [namespace parent]
- if {![string compare :: $parent]} {
+ if {"::" eq $parent } {
set parent {}
}
Index: openacs-4/packages/acs-tcl/tcl/test/acs-tcl-apm-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/acs-tcl-apm-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-tcl/tcl/test/acs-tcl-apm-procs.tcl 31 Aug 2006 20:08:51 -0000 1.1
+++ openacs-4/packages/acs-tcl/tcl/test/acs-tcl-apm-procs.tcl 10 Jan 2007 21:22:12 -0000 1.2
@@ -16,7 +16,7 @@
set package_list [db_list get_packages "select package_key from apm_package_types"]
aa_log "List of packages:\{$package_list\}"
- set list_index [randomRange [expr [llength $package_list] - 1]]
+ set list_index [randomRange [expr {[llength $package_list] - 1}]]
set package_key [lrange $package_list $list_index $list_index]
set parameter_name [ad_generate_random_string]
@@ -31,7 +31,7 @@
# Choose randomly the parameter whether will be string or number.
# Also choose randomly its default value.
set datatype [lrange $values $index $index]
- if { [string equal $datatype "number"]} {
+ if {$datatype eq "number"} {
set default_value 0
} else {
set default_value [ad_generate_random_string]
@@ -56,7 +56,7 @@
set package_list [db_list get_packages "select package_key from apm_package_types"]
aa_log "List of packages:\{$package_list\}"
- set list_index [randomRange [expr [llength $package_list] - 1]]
+ set list_index [randomRange [expr {[llength $package_list] - 1}]]
set package_key [lrange $package_list $list_index $list_index]
set instance_name $package_key
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 -r1.36 -r1.37
--- openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl 11 Aug 2006 10:10:14 -0000 1.36
+++ openacs-4/packages/acs-tcl/tcl/test/acs-tcl-test-procs.tcl 10 Jan 2007 21:22:12 -0000 1.37
@@ -71,7 +71,7 @@
from apm_package_versions
where version_id = :version_id}]
set auto_mount $auto_mount_orig
- if { [empty_string_p $auto_mount] } {
+ if { $auto_mount eq "" } {
set auto_mount "test_auto_mount_dir"
db_dml set_test_mount {update apm_package_versions
set auto_mount = :auto_mount
@@ -285,7 +285,7 @@
[site_node::get_children -all -element node_id -node_id $node_id -package_type "apm_service"] \
$nodes
- aa_true "Found at least one apm_service node" [expr [llength $nodes] > 0]
+ aa_true "Found at least one apm_service node" [expr {[llength $nodes] > 0}]
# nonexistent package_type
aa_true "No nodes with package type 'foo'" \
@@ -1040,7 +1040,7 @@
} {
set value [random]
- if {![string equal $parameter_name "PasswordExpirationDays"] && $value > 0.7} {
+ if {$parameter_name ne "PasswordExpirationDays" && $value > 0.7} {
set package_id [apm_package_id_from_key $package_key]
set actual_value [db_string real_value {
@@ -1064,12 +1064,12 @@
aa_true "check parameter::set_default" \
[string equal $value $value_db]
- set value [expr $value + 10]
+ set value [expr {$value + 10}]
parameter::set_from_package_key -package_key $package_key -parameter $parameter_name -value $value
aa_true "check parameter::set_from_package_key" \
[string equal $value [parameter::get -package_id $package_id -parameter $parameter_name]]
- set value [expr $value + 10]
+ set value [expr {$value + 10}]
parameter::set_value -package_id $package_id -parameter $parameter_name -value $value
aa_true "check parameter::set_value" \
[string equal $value [parameter::get -package_id $package_id -parameter $parameter_name]]
@@ -1088,5 +1088,5 @@
# Retrieve an objects_package_id
set object_id [db_string get_object_id "select max(object_id) from acs_objects where package_id >0"]
set package_id [db_string get_package_id "select package_id from acs_objects where object_id = :object_id"]
- aa_true "package_id returned is correct" [string eq $package_id [acs_object::package_id -object_id $object_id]]
+ aa_true "package_id returned is correct" [string equal $package_id [acs_object::package_id -object_id $object_id]]
}
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 -r1.7 -r1.8
--- openacs-4/packages/acs-tcl/tcl/test/ad-proc-test-procs.tcl 27 Oct 2006 20:34:49 -0000 1.7
+++ openacs-4/packages/acs-tcl/tcl/test/ad-proc-test-procs.tcl 10 Jan 2007 21:22:12 -0000 1.8
@@ -129,7 +129,7 @@
[expr {[callback -impl an_impl2 a_callback -arg1 {} {}] == {}}]
aa_true "callback errors with missing arg" \
- [expr [catch {callback -impl an_impl2 a_callback -arg1 foo} err] == 1]
+ [expr {[catch {callback -impl an_impl2 a_callback -arg1 foo} err] == 1}]
aa_true "throws error for invalid arguments with implementations" \
[catch {callback a_callback bar} error]
Index: openacs-4/packages/acs-tcl/tcl/test/community-core-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/community-core-test-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-tcl/tcl/test/community-core-test-procs.tcl 10 Aug 2006 21:22:47 -0000 1.1
+++ openacs-4/packages/acs-tcl/tcl/test/community-core-test-procs.tcl 10 Jan 2007 21:22:12 -0000 1.2
@@ -54,7 +54,7 @@
-password $password -secret_question [ad_generate_random_string] \
-secret_answer [ad_generate_random_string]]
- if { ![string equal $user_info(creation_status) ok] } {
+ if { $user_info(creation_status) ne "ok" } {
# Could not create user
error "Could not create test user with username=$username user_info=[array get user_info]"
}
@@ -119,7 +119,7 @@
-secret_question [ad_generate_random_string] \
-secret_answer [ad_generate_random_string]]
- if { ![string equal $user_info(creation_status) ok] } {
+ if { $user_info(creation_status) ne "ok" } {
# Could not create user
error "Could not create test user with username=$username user_info=[array get user_info]"
}
Index: openacs-4/packages/acs-tcl/tcl/test/datamodel-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/datamodel-test-procs.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-tcl/tcl/test/datamodel-test-procs.tcl 31 Aug 2006 20:44:01 -0000 1.9
+++ openacs-4/packages/acs-tcl/tcl/test/datamodel-test-procs.tcl 10 Jan 2007 21:22:12 -0000 1.10
@@ -13,7 +13,7 @@
@author Jeff Davis davis@xarg.net
} {
- set db_is_pg_p [string eq [db_name] "PostgreSQL"]
+ set db_is_pg_p [string equal [db_name] "PostgreSQL"]
if { $db_is_pg_p } {
set get_constraints "select
@@ -64,7 +64,7 @@
set column_name [db_string get_col $get_constraint_col]
# NOT NULL constraints (oracle only)
- if { [string eq $search_condition "\"$column_name\" IS NOT NULL"] } {
+ if { [string equal $search_condition "\"$column_name\" IS NOT NULL"] } {
set constraint_type "NN"
}
@@ -77,13 +77,13 @@
}
# Giving a hint for constraint naming
- if { [string eq [string range $standard_name 0 2] "SYS"] } {
+ if {[string range $standard_name 0 2] eq "SYS"} {
set hint "unnamed"
} else {
set hint "hint: $standard_name"
}
- if { ![string eq $standard_name $constraint_name] } {
+ if { $standard_name ne $constraint_name } {
aa_log_result fail "Table $table_name constraint $constraint_name ($constraint_type) violates naming standard ($hint)"
}
}
@@ -99,17 +99,17 @@
@author Jeff Davis davis@xarg.net
} {
db_foreach object_type {select * from acs_object_types} {
- if {![string eq [string tolower $table_name] $table_name]} {
+ if {[string tolower $table_name] ne $table_name } {
aa_log_result fail "Type $object_type: table_name $table_name mixed case"
}
- if {![string eq [string tolower $id_column] $id_column]} {
+ if {[string tolower $id_column] ne $id_column } {
aa_log_result fail "Type $object_type: id_column $id_column mixed case"
}
set table_name [string tolower $table_name]
set id_column [string tolower $id_column]
set the_pk {}
- while { [string is space $table_name] && ![string eq $object_type $supertype]} {
+ while { [string is space $table_name] && $object_type ne $supertype } {
if {![db_0or1row get_supertype "select * from acs_object_types where object_type = :supertype"]} {
break
}
@@ -129,7 +129,7 @@
}
if {![string is space $name_method]} {
- if {![string eq [string tolower $name_method] $name_method]} {
+ if {[string tolower $name_method] ne $name_method } {
aa_log_result fail "Type $object_type: name method $name_method mixed case"
}
set name_method [string tolower $name_method]
@@ -173,7 +173,7 @@
db_foreach attribute {select a.*, lower(ot.table_name) as obj_type_table from acs_attributes a, acs_object_types ot where ot.object_type = a.object_type order by a.object_type} {
- if {![string eq [string tolower $table_name] $table_name]} {
+ if {[string tolower $table_name] ne $table_name } {
aa_log_result fail "Type $object_type attribute $attribute table name $table_name mixed case"
set table_name [string tolower $table_name]
} elseif {[string is space $table_name]} {
Index: openacs-4/packages/acs-tcl/tcl/test/file-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/file-test-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-tcl/tcl/test/file-test-procs.tcl 15 Dec 2006 00:02:01 -0000 1.6
+++ openacs-4/packages/acs-tcl/tcl/test/file-test-procs.tcl 10 Jan 2007 21:22:12 -0000 1.7
@@ -15,7 +15,7 @@
set nfiles 0
# couple of local helper procs
proc ::tcl_p {file} {
- return [expr [string match {*.tcl} $file] || [file isdirectory $file]]
+ return [expr {[string match {*.tcl} $file] || [file isdirectory $file]}]
}
# if startdir is not [acs_root_dir]/packages, then somebody checked in the wrong thing by accident
@@ -48,7 +48,7 @@
} {
# couple of local helper procs
proc ::tcl_p {file} {
- return [expr [string match {*.tcl} $file] || [file isdirectory $file]]
+ return [expr {[string match {*.tcl} $file] || [file isdirectory $file]}]
}
# if startdir is not [acs_root_dir]/packages, then somebody checked in the wrong thing by accident
@@ -90,11 +90,11 @@
set errp 1
}
# check on the requires, provides, etc stuff.
- if {[empty_string_p $version(provides)]
+ if {$version(provides) eq ""
&& [string equal $version(package.type) apm_service] } {
aa_log_result fail "$spec_file SERVICE MISSING PROVIDES: $key"
set errp 1
- } elseif { ![empty_string_p $version(provides)]} {
+ } elseif { $version(provides) ne ""} {
if { ![string equal $version(name) [lindex [lindex $version(provides) 0] 1]]} {
aa_log_result fail "$spec_file: MISMATCH PROVIDES VERSION: $version(provides) $version(name)"
set errp 1
@@ -145,12 +145,12 @@
[string first upgrade $file] == -1 } {
set db [apm_guess_db_type $package $file]
if {[string is space $db]
- || [string equal $db $db_type]} {
+ || $db eq $db_type} {
set tail [file tail $file]
if {[regexp {\-(.*)-(.*).sql} $tail match v1 v2]} {
set v1s [apm_version_sortable $v1]
set v2s [apm_version_sortable $v2]
- if {[string compare $v1s $v2s] > -1} {
+ if {$v1s ne $v2s > -1} {
set error_p 1
aa_log_result fail "$file: from after to version"
} else {
@@ -170,7 +170,7 @@
set u2 [lsort -dictionary -index 1 $upgrades]
foreach f1 $u1 f2 $u2 {
- if {![string equal $f1 $f2]} {
+ if {$f1 ne $f2 } {
set error_p 1
aa_log_result fail "$package upgrade not well ordered [lindex $f1 end] [lindex $f2 end]\n"
}
@@ -196,7 +196,7 @@
} {
# couple of local helper procs
proc ::xql_p {file} {
- return [expr [string match {*.xql} $file] || [file isdirectory $file]]
+ return [expr {[string match {*.xql} $file] || [file isdirectory $file]}]
}
# if startdir is not [acs_root_dir]/packages, then somebody checked in the wrong thing by accident
@@ -236,21 +236,21 @@
# the file did not exist so we must have a -db extension...
regexp {(.*?)(-)?([A-Za-z_]*)[.]xql$} $file match base dummy db
ns_log debug "JCD: acs_tcl__check_xql_files: $db $base from $file"
- if { ![empty_string_p $db]
- && ![empty_string_p $dummy]
+ if { $db ne ""
+ && $dummy ne ""
&& ![string match $db oracle]
&& ![string match $db postgresql] } {
aa_log_result fail "bad db name \"$db\" file $file (or maybe .tcl or .vuh missing)"
- } elseif { ![empty_string_p $db]
- && ![empty_string_p $dummy]
+ } elseif { $db ne ""
+ && $dummy ne ""
&& ![regexp $db $data] } {
aa_log_result fail "rdbms \"$db\" missing $file"
- } elseif {[empty_string_p $dummy]
+ } elseif {$dummy eq ""
&& [regexp {<rdbms>} $data] } {
aa_log_result fail "rdbms found in generic $file"
}
- if {[string equal $db postgresql] || [empty_string_p $dummy]} {
+ if {$db eq "postgresql" || $dummy eq ""} {
if {[regexp -nocase {(nvl[ ]*\(|decode[ ]*\(| connect by )} $data match]} {
aa_log_result fail "postgres or generic with oracle code $file: $match"
}
@@ -259,7 +259,7 @@
}
set allxql($base) $file
} else {
- if {[regexp -nocase {(now[ ]*\(| limit | offset | outer join )} $data match ] || [empty_string_p $dummy]} {
+ if {[regexp -nocase {(now[ ]*\(| limit | offset | outer join )} $data match ] || $dummy eq ""} {
aa_log_result fail "oracle or generic with postgres code $file: $match"
}
set allxql($base) $file
Index: openacs-4/packages/acs-tcl/tcl/test/log-test-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/Attic/log-test-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-tcl/tcl/test/log-test-procs.tcl 27 Feb 2005 16:16:17 -0000 1.3
+++ openacs-4/packages/acs-tcl/tcl/test/log-test-procs.tcl 10 Jan 2007 21:22:12 -0000 1.4
@@ -13,7 +13,7 @@
set logfile [ns_info log]
- if { [string equal $logfile "STDOUT"] } {
+ if {$logfile eq "STDOUT"} {
set logfile "[acs_root_dir]/log/error/current"
}
@@ -28,7 +28,7 @@
aa_log_result "fail" "$timestamp: $entry"
set inside_error_p 0
}
- if { [string equal $level "Error"] } {
+ if {$level eq "Error"} {
set inside_error_p 1
set entry {}
append entry $rest \n
Index: openacs-4/packages/acs-tcl/tcl/test/navigation-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/navigation-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-tcl/tcl/test/navigation-procs.tcl 22 Sep 2006 21:36:23 -0000 1.3
+++ openacs-4/packages/acs-tcl/tcl/test/navigation-procs.tcl 10 Jan 2007 21:22:12 -0000 1.4
@@ -90,7 +90,7 @@
set leave_node "ref_final"
set root_node [list "/" \#acs-kernel.Main_Site\#]
- if { [string match admin/* [ad_conn extra_url]] } {
+ if { [string match "admin/*" [ad_conn extra_url]] } {
set admin_node [list "[ad_conn package_url]admin/" "Administration"]
} else {
set admin_node ""
Index: openacs-4/packages/acs-tcl/tcl/test/object-test-case-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/object-test-case-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-tcl/tcl/test/object-test-case-procs.tcl 24 Oct 2006 13:25:07 -0000 1.4
+++ openacs-4/packages/acs-tcl/tcl/test/object-test-case-procs.tcl 10 Jan 2007 21:22:12 -0000 1.5
@@ -28,7 +28,7 @@
set the_id [db_nextval acs_object_id_seq]
aa_run_with_teardown -test_code {
- if { [string eq [db_name] "PostgreSQL"] } {
+ if {[db_name] eq "PostgreSQL"} {
set type_create_sql "select acs_object_type__create_type (
:object_type,
:pretty_name,
Index: openacs-4/packages/acs-tcl/tcl/test/test-permissions-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/test-permissions-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-tcl/tcl/test/test-permissions-procs.tcl 14 Jul 2006 23:41:29 -0000 1.1
+++ openacs-4/packages/acs-tcl/tcl/test/test-permissions-procs.tcl 10 Jan 2007 21:22:12 -0000 1.2
@@ -32,52 +32,52 @@
permission::grant -party_id $user_id -object_id $new_package_id -privilege "admin"
#Verifying the admin privilege on the user
aa_true "testing admin privilige" \
- [expr [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "admin"] == 1]
+ [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "admin"] == 1}]
#Revoking admin privilege
permission::revoke -party_id $user_id -object_id $new_package_id -privilege "admin"
aa_true "testing if admin privilige was revoked" \
- [expr [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "admin"] == 0]
+ [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "admin"] == 0}]
#Grant read privilege
permission::grant -party_id $user_id -object_id $new_package_id -privilege "read"
#Verifying the read privilege on the user
aa_true "testing read permissions" \
- [expr [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "read" ] == 1]
+ [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "read" ] == 1}]
#Revoking read privilege
permission::revoke -party_id $user_id -object_id $new_package_id -privilege "read"
#We tested with a query because we have problems with inherit
aa_true "testing if read privilige was revoked" \
- [expr [db_string test_read "select 1 from acs_permissions where object_id = :new_package_id and grantee_id = :user_id" -default 0] == 0]
+ [expr {[db_string test_read "select 1 from acs_permissions where object_id = :new_package_id and grantee_id = :user_id" -default 0] == 0}]
#Grant write privilege
permission::grant -party_id $user_id -object_id $new_package_id -privilege "write"
#Verifying the write privilege on the user
aa_true "testing write permissions" \
- [expr [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "write" ] == 1]
+ [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "write" ] == 1}]
#Revoking write privilege
permission::revoke -party_id $user_id -object_id $new_package_id -privilege "write"
aa_true "testing if write permissions was revoked" \
- [expr [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "write" ] == 0]
+ [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "write" ] == 0}]
#Grant create privilege
permission::grant -party_id $user_id -object_id $new_package_id -privilege "create"
#Verifying the create privelege on the user
aa_true "testing create permissions" \
- [expr [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "create" ] == 1]
+ [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "create" ] == 1}]
#Revoking create privilege
permission::revoke -party_id $user_id -object_id $new_package_id -privilege "create"
aa_true "testing if create privileges was revoked" \
- [expr [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "create" ] == 0]
+ [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "create" ] == 0}]
#Grant delete privilege
permission::grant -party_id $user_id -object_id $new_package_id -privilege "delete"
#Verifying the delete privilege on the user
aa_true "testing delete permissions" \
- [expr [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "delete" ] == 1]
+ [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "delete" ] == 1}]
#Revoking delete privilege
permission::revoke -party_id $user_id -object_id $new_package_id -privilege "delete"
aa_true "testing if delete permissions was revoked" \
- [expr [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "delete" ] == 0]
+ [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "delete" ] == 0}]
}
}
@@ -100,27 +100,27 @@
#Grant permissions for this user in this object
permission::grant -party_id $user_id -object_id $new_package_id -privilege "delete"
aa_true "testing admin permissions" \
- [expr [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "delete" ] == 1]
+ [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "delete" ] == 1}]
permission::revoke -party_id $user_id -object_id $new_package_id -privilege "delete"
permission::grant -party_id $user_id -object_id $new_package_id -privilege "create"
aa_true "testing create permissions" \
- [expr [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "create" ] == 1]
+ [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "create" ] == 1}]
permission::revoke -party_id $user_id -object_id $new_package_id -privilege "create"
permission::grant -party_id $user_id -object_id $new_package_id -privilege "write"
aa_true "testing write permissions" \
- [expr [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "write" ] == 1]
+ [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "write" ] == 1}]
permission::revoke -party_id $user_id -object_id $new_package_id -privilege "write"
permission::grant -party_id $user_id -object_id $new_package_id -privilege "read"
aa_true "testing read permissions" \
- [expr [db_string test_read "select 1 from acs_permissions where object_id = :new_package_id and grantee_id = :user_id" -default 0] == 1]
+ [expr {[db_string test_read "select 1 from acs_permissions where object_id = :new_package_id and grantee_id = :user_id" -default 0] == 1}]
permission::revoke -party_id $user_id -object_id $new_package_id -privilege "read"
permission::grant -party_id $user_id -object_id $new_package_id -privilege "admin"
aa_true "testing delete permissions" \
- [expr [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "admin" ] == 1]
+ [expr {[permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "admin" ] == 1}]
permission::revoke -party_id $user_id -object_id $new_package_id -privilege "admin"
}
}
\ 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 -r1.3 -r1.4
--- openacs-4/packages/acs-tcl/tcl/test/whos-online-procs.tcl 11 Aug 2006 23:18:13 -0000 1.3
+++ openacs-4/packages/acs-tcl/tcl/test/whos-online-procs.tcl 10 Jan 2007 21:22:12 -0000 1.4
@@ -43,7 +43,7 @@
whos_online::set_invisible $user_id
- aa_true "User $user_info(email) is Invisible" [expr [nsv_exists invisible_users $user_id] == 1 ]
+ aa_true "User $user_info(email) is Invisible" [expr {[nsv_exists invisible_users $user_id] == 1 }]
#---------------------------------------------------------------------------------------------------
#Test all-invisible_user_ids
@@ -61,7 +61,7 @@
whos_online::unset_invisible $user_id
aa_false "User $user_info(email) is Visible" \
- [expr [whos_online::user_invisible_p $user_id ] == 1 ]
+ [expr {[whos_online::user_invisible_p $user_id ] == 1 }]
#---------------------------------------------------------------------------------------------------
#Test user_ids
Index: openacs-4/packages/acs-templating/tcl/acs-integration-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/acs-integration-procs.tcl,v
diff -u -r1.16 -r1.17
--- openacs-4/packages/acs-templating/tcl/acs-integration-procs.tcl 26 Feb 2005 17:52:21 -0000 1.16
+++ openacs-4/packages/acs-templating/tcl/acs-integration-procs.tcl 10 Jan 2007 21:22:12 -0000 1.17
@@ -23,7 +23,7 @@
@param string If specified, will return the resulting page to the caller
string instead sending it to the connection.
} {
- if {![empty_string_p $template]} {
+ if {$template ne ""} {
template::set_file \
[template::util::url_to_file $template [ad_conn file]]
}
@@ -100,7 +100,7 @@
set parsed_template [template::adp_parse [file root [ad_conn file]] {}]
- if {![empty_string_p $parsed_template]} {
+ if {$parsed_template ne ""} {
#
# acs-lang translator mode
@@ -123,18 +123,18 @@
if { [string first "</select" [string tolower $select]] != -1 } {
set start [lindex $indices 1]
} else {
- set before [string range $parsed_template 0 [expr [lindex $indices 0]-1]]
+ set before [string range $parsed_template 0 [expr {[lindex $indices 0]-1}]]
set message [string range $parsed_template [lindex $message_idx 0] [lindex $message_idx 1]]
- set after [string range $parsed_template [expr [lindex $indices 1] + 1] end]
+ set after [string range $parsed_template [expr {[lindex $indices 1] + 1}] end]
set parsed_template "${before}${message}${select}${after}"
}
}
# TODO: We could also move message keys out of <head>...</head>
while { [regexp -indices {\x002\(\x001([^\x001]*)\x001\)\x002} $parsed_template indices key] } {
- set before [string range $parsed_template 0 [expr [lindex $indices 0] - 1]]
- set after [string range $parsed_template [expr [lindex $indices 1] + 1] end]
+ set before [string range $parsed_template 0 [expr {[lindex $indices 0] - 1}]]
+ set after [string range $parsed_template [expr {[lindex $indices 1] + 1}] end]
set key [string range $parsed_template [lindex $key 0] [lindex $key 1]]
Index: openacs-4/packages/acs-templating/tcl/apm-callback-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/apm-callback-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-templating/tcl/apm-callback-procs.tcl 18 Aug 2006 19:03:06 -0000 1.3
+++ openacs-4/packages/acs-templating/tcl/apm-callback-procs.tcl 10 Jan 2007 21:22:12 -0000 1.4
@@ -29,7 +29,7 @@
-package_id $package_id \
-parameter DefaultFormStyle]
- if { [string equal $DefaultFormStyle "standard-lars"] } {
+ if {$DefaultFormStyle eq "standard-lars"} {
parameter::set_value \
-package_id $package_id \
-parameter DefaultFormStyle \
@@ -45,7 +45,7 @@
-package_id $package_id \
-parameter DefaultFormStyle]
- if { [string equal $DefaultFormStyle "standard-lars"] } {
+ if {$DefaultFormStyle eq "standard-lars"} {
parameter::set_value \
-package_id $package_id \
-parameter DefaultFormStyle \
Index: openacs-4/packages/acs-templating/tcl/currency-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/currency-procs.tcl,v
diff -u -r1.11 -r1.12
--- openacs-4/packages/acs-templating/tcl/currency-procs.tcl 29 Jul 2006 00:35:48 -0000 1.11
+++ openacs-4/packages/acs-templating/tcl/currency-procs.tcl 10 Jan 2007 21:22:12 -0000 1.12
@@ -97,7 +97,7 @@
set format_fractional_part [lindex $format 3]
set whole_part_valid_p [template::data::validate integer whole_part message]
- if { ![empty_string_p $fractional_part] } {
+ if { $fractional_part ne "" } {
set fractional_part_valid_p [template::data::validate integer fractional_part message]
} else {
set fractional_part_valid_p 1
@@ -139,7 +139,7 @@
# let's put a leading zero if the whole part is empty
if { $i == 1 } {
- if { [string equal $value ""] } {
+ if {$value eq ""} {
set value 0
} else {
set have_values 1
@@ -148,11 +148,11 @@
# and let's fill in the zeros at the end up to the precision
if { $i == 3 } {
- if { ![string equal $value ""] } {
+ if { $value ne "" } {
set have_values 1
}
set fractional_part_format [lindex $format 3]
- for { set j [string length $value] } { $j < $fractional_part_format } { set j [expr $j + 1] } {
+ for { set j [string length $value] } { $j < $fractional_part_format } { set j [expr {$j + 1}] } {
append $value 0
}
}
@@ -203,7 +203,7 @@
switch $what {
sql_number {
- if { [empty_string_p $value]} {
+ if { $value eq ""} {
return ""
}
@@ -271,7 +271,7 @@
}
sql_number {
- if { [empty_string_p $whole_part] && [empty_string_p $fractional_part] } {
+ if { $whole_part eq "" && $fractional_part eq "" } {
return ""
}
@@ -284,7 +284,7 @@
}
display_currency {
- if { [empty_string_p $whole_part] && [empty_string_p $fractional_part] } {
+ if { $whole_part eq "" && $fractional_part eq "" } {
return ""
}
@@ -350,7 +350,7 @@
}
if { $i == 0 || $i == 2 || $i == 4 } {
append output "$format_property<input type=\"hidden\" name=\"$element(name).$i\" value=\"$format_property\" />"
- } elseif { [string equal $element(mode) "edit"] && ($i == 1 || $i == 3) } {
+ } elseif { $element(mode) eq "edit" && ($i == 1 || $i == 3) } {
append output "<input type=\"text\" name=\"$element(name).$i\" maxlength=\"$format_property\" size=\"$format_property\" value=\"$value$trailing_zero\" />\n"
} else {
append output "$value$trailing_zero<input type=\"hidden\" name=\"$element(name).$i\" maxlength=\"$format_property\" size=\"$format_property\" value=\"$value\" />"
Index: openacs-4/packages/acs-templating/tcl/data-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/data-procs.tcl,v
diff -u -r1.13 -r1.14
--- openacs-4/packages/acs-templating/tcl/data-procs.tcl 29 Jul 2006 23:10:33 -0000 1.13
+++ openacs-4/packages/acs-templating/tcl/data-procs.tcl 10 Jan 2007 21:22:12 -0000 1.14
@@ -358,7 +358,7 @@
set proc_name [info procs ::template::data::transform::$type]
- if { ! [string equal $proc_name {}] } {
+ if { $proc_name ne {} } {
transform::$type $value_ref
}
Index: openacs-4/packages/acs-templating/tcl/date-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/date-procs.tcl,v
diff -u -r1.37 -r1.38
--- openacs-4/packages/acs-templating/tcl/date-procs.tcl 29 Jul 2006 23:10:33 -0000 1.37
+++ openacs-4/packages/acs-templating/tcl/date-procs.tcl 10 Jan 2007 21:22:12 -0000 1.38
@@ -80,7 +80,7 @@
ad_proc -public template::util::date::monthName { month length } {
Return the specified month name (short or long)
} {
- if { [string equal $length long] } {
+ if {$length eq "long"} {
return [lc_time_fmt "2002-[format "%02d" $month]-01" "%B"]
} else {
return [lc_time_fmt "2002-[format "%02d" $month]-01" "%b"]
@@ -98,10 +98,10 @@
set days [lindex $month_desc 2]
if { $month == 2 && (
- ([expr $year % 4] == 0 && [expr $year % 100] != 0) ||
- [expr $year % 400] == 0
+ (($year % 4) == 0 && ($year % 100) != 0) ||
+ ($year % 400) == 0
) } {
- return [expr $days + 1]
+ return [expr {$days + 1}]
} else {
return $days
}
@@ -212,14 +212,14 @@
seconds { return [lindex $date 5] }
format { return [lindex $date 6] }
long_month_name {
- if { [string equal [lindex $date 1] {}] } {
+ if {[lindex $date 1] eq {}} {
return {}
} else {
return [monthName [lindex $date 1] long]
}
}
short_month_name {
- if { [string equal [lindex $date 1] {}] } {
+ if {[lindex $date 1] eq {}} {
return {}
} else {
return [monthName [lindex $date 1] short]
@@ -235,17 +235,17 @@
}
}
short_year {
- if { [string equal [lindex $date 0] {}] } {
+ if {[lindex $date 0] eq {}} {
return {}
} else {
- return [expr [lindex $date 0] % 100]
+ return [expr {[lindex $date 0] % 100}]
}
}
short_hours {
- if { [string equal [lindex $date 3] {}] } {
+ if {[lindex $date 3] eq {}} {
return {}
} else {
- set value [expr [lindex $date 3] % 12]
+ set value [expr {[lindex $date 3] % 12}]
if { $value == 0 } {
return 12
} else {
@@ -254,7 +254,7 @@
}
}
ampm {
- if { [string equal [lindex $date 3] {}] } {
+ if {[lindex $date 3] eq {}} {
return {}
} else {
if { [lindex $date 3] > 11 } {
@@ -266,15 +266,15 @@
}
not_null {
for { set i 0 } { $i < 6 } { incr i } {
- if { ![string equal [lindex $date $i] {}] } {
+ if { [lindex $date $i] ne {} } {
return 1
}
}
return 0
}
sql_date {
# LARS: Empty date results in NULL value
- if { [empty_string_p $date] } {
+ if { $date eq "" } {
return "NULL"
}
set value ""
@@ -283,7 +283,7 @@
set pad "0000"
foreach { index sql_form } { 0 YYYY 1 MM 2 DD 3 HH24 4 MI 5 SS } {
set piece [lindex $date $index]
- if { ![string equal $piece {}] } {
+ if { $piece ne {} } {
append value "$space[string range $pad [string length $piece] end]$piece"
append format $space
append format $sql_form
@@ -304,7 +304,7 @@
}
ansi {
# LARS: Empty date results in NULL value
- if { [empty_string_p $date] } {
+ if { $date eq "" } {
return {}
}
set value ""
@@ -364,10 +364,10 @@
}
set value [lc_time_fmt [join $date_list "-"] "%q"]
unpack $date
- if { ![string equal $hours {}] && \
- ![string equal $minutes {}] } {
+ if { $hours ne {} && \
+ $minutes ne {} } {
append value " [string range $pad [string length $hours] end]${hours}:[string range $pad [string length $minutes] end]$minutes"
- if { ![string equal $seconds {}] } {
+ if { $seconds ne {} } {
append value ":[string range $pad [string length $seconds] end]$seconds"
}
}
@@ -377,15 +377,15 @@
set value ""
# Unreliable !
unpack $date
- if { ![string equal $year {}] && \
- ![string equal $month {}] && \
- ![string equal $day {}] } {
+ if { $year ne {} && \
+ $month ne {} && \
+ $day ne {} } {
append value "$month/$day/$year"
}
- if { ![string equal $hours {}] && \
- ![string equal $minutes {}] } {
+ if { $hours ne {} && \
+ $minutes ne {} } {
append value " ${hours}:${minutes}"
- if { ![string equal $seconds {}] } {
+ if { $seconds ne {} } {
append value ":$seconds"
}
}
@@ -427,7 +427,7 @@
# This is needed for the automated sql/linear conversion used by
# ad_form.
- if {[empty_string_p $value]} {
+ if {$value eq ""} {
return $date
}
@@ -450,16 +450,16 @@
format { return [lreplace $date 6 6 $value] }
short_year {
if { $value < 69 } {
- return [lreplace $date 0 0 [expr $value + 2000]]
+ return [lreplace $date 0 0 [expr {$value + 2000}]]
} else {
- return [lreplace $date 0 0 [expr $value + 1900]]
+ return [lreplace $date 0 0 [expr {$value + 1900}]]
}
}
short_hours {
return [lreplace $date 3 3 $value]
}
ampm {
- if { [string equal [lindex $date 3] {}] } {
+ if {[lindex $date 3] eq {}} {
return $date
} else {
set hours [lindex $date 3]
@@ -470,10 +470,10 @@
set hours $trimmed_hours
}
- if { [string equal $value pm] && $hours < 12 } {
- return [lreplace $date 3 3 [expr $hours + 12]]
- } elseif { [string equal $value am] } {
- return [lreplace $date 3 3 [expr $hours % 12]]
+ if { $value eq "pm" && $hours < 12 } {
+ return [lreplace $date 3 3 [expr {$hours + 12}]]
+ } elseif {$value eq "am"} {
+ return [lreplace $date 3 3 [expr {$hours % 12}]]
} else {
return $date
}
@@ -651,17 +651,17 @@
# add time properties
foreach field [array names time_in] {
# skip format
- if ![string equal $field "format"] {
+ if {$field ne "format" } {
# Coerce values to non-negative integers
- if { ![string equal $field ampm] } {
+ if { $field ne "ampm" } {
if { ![regexp {[0-9]+} $time_in($field) value] } {
set value {}
}
}
# If the value is not null, set it
- if { ![string equal $value {}] } {
+ if { $value ne {} } {
set the_date [template::util::date::set_property $field $the_date $value]
- if { ![string equal $field ampm] } {
+ if { $field ne "ampm" } {
set have_values 1
}
}
@@ -671,13 +671,13 @@
# add date properties
foreach field [array names date_in] {
# skip format
- if ![string equal $field "format"] {
+ if {$field ne "format" } {
# Coerce values to non-negative integers
if { ![regexp {[0-9]+} $date_in($field) value] } {
set value {}
}
# If the value is not null, set it
- if { ![string equal $value {}] } {
+ if { $value ne {} } {
set the_date [template::util::date::set_property $field $the_date $value]
set have_values 1
}
@@ -695,10 +695,10 @@
Check if a value is less than zero, but return false
if the value is an empty string
} {
- if { [string equal $value {}] } {
+ if {$value eq {}} {
return 0
} else {
- return [expr $value < 0]
+ return [expr {$value < 0}]
}
}
@@ -724,7 +724,7 @@
hours "HH24|HH12" minutes "MI" seconds "SS" } {
# If the field is required, but missing, report an error
- if { [string equal [set $field] {}] } {
+ if {[set $field] eq {}} {
if { [regexp $exp $format match] } {
set field_pretty [_ acs-templating.${field}]
lappend error_msg [_ acs-templating.lt_No_value_supplied_for_-field_pretty-]
@@ -743,12 +743,12 @@
lappend error_msg [_ acs-templating.Year_must_be_positive]
}
- if { ![string equal $month {}] } {
+ if { $month ne {} } {
if { $month < 1 || $month > 12 } {
lappend error_msg [_ acs-templating.Month_must_be_between_1_and_12]
} else {
if { $year > 0 } {
- if { ![string equal $day {}] } {
+ if { $day ne {} } {
set maxdays [get_property days_in_month $date]
if { $day < 1 || $day > $maxdays } {
set month_pretty [template::util::date::get_property long_month_name $date]
@@ -788,11 +788,11 @@
Pad a string with leading zeroes
} {
- if { [string equal $string {}] } {
+ if {$string eq {}} {
return {}
}
- set ret [string repeat "0" [expr $size - [string length $string]]]
+ set ret [string repeat "0" [expr {$size - [string length $string]}]]
append ret $string
return $ret
@@ -804,7 +804,7 @@
} {
set empty [string equal $value {}]
set value [string trimleft $value 0]
- if { !$empty && [string equal $value {}] } {
+ if { !$empty && $value eq {} } {
set value 0
}
return $value
@@ -843,7 +843,7 @@
if {$interval_size > 1} {
# round minutes or seconds to nearest interval
- if { ![empty_string_p $value] } {
+ if { $value ne "" } {
set value [expr {$value-($value - [lindex $interval_def 0])%$interval_size}]
}
}
@@ -865,7 +865,7 @@
set value [template::util::date::get_property $fragment $value]
set value [template::util::leadingTrim $value]
- if { ![string equal $mode "edit"] } {
+ if { $mode ne "edit" } {
set output {}
append output "<input type=\"hidden\" name=\"$element(name).$fragment\" value=\"[template::util::leadingPad $value $size]\">"
append output $value
@@ -875,13 +875,13 @@
set interval $element(${fragment}_interval)
} else {
# Display text entry for some elements, or if the type is text
- if { [string equal $type t] ||
+ if { $type eq "t" ||
[regexp "year|short_year" $fragment] } {
set output "<input type=\"text\" name=\"$element(name).$fragment\" size=\"$size\""
append output " maxlength=\"$size\" value=\"[template::util::leadingPad $value $size]\""
array set attributes $tag_attributes
foreach attribute_name [array names attributes] {
- if { [string equal $attributes($attribute_name) {}] } {
+ if {$attributes($attribute_name) eq {}} {
append output " $attribute_name"
} else {
append output " $attribute_name=\"$attributes($attribute_name)\""
@@ -909,7 +909,7 @@
set value [template::util::date::get_property $fragment $value]
- if { ![string equal $mode "edit"] } {
+ if { $mode ne "edit" } {
set output {}
append output "<input type=\"hidden\" name=\"$element(name).$fragment\" value=\"$value\">"
append output $value
@@ -932,7 +932,7 @@
set value [template::util::date::get_property $fragment $value]
- if { ![string equal $mode "edit"] } {
+ if { $mode ne "edit" } {
set output {}
if { [exists_and_not_null value] } {
append output "<input type=\"hidden\" name=\"$element(name).$fragment\" value=\"$value\">"
@@ -1000,9 +1000,9 @@
expiration {
set element(format) "MM/YY"
set current_year [clock format [clock seconds] -format "%Y"]
- set current_year [expr $current_year % 100]
+ set current_year [expr {$current_year % 100}]
set element(short_year_interval) \
- [list $current_year [expr $current_year + 10] 1]
+ [list $current_year [expr {$current_year + 10}] 1]
set element(help) 1
}
}
@@ -1035,7 +1035,7 @@
set id_attr_name $attributes(id)
}
- while { ![string equal $format_string {}] } {
+ while { $format_string ne {} } {
# Snip off the next token
regexp {([^/\-.: ]*)([/\-.: ]*)(.*)} \
@@ -1066,7 +1066,7 @@
[array get attributes]]
# Output the separator
- if { [string equal $sep " "] } {
+ if {$sep eq " "} {
append output " "
} else {
append output "$sep"
@@ -1114,15 +1114,15 @@
if { [ns_queryexists $key] } {
set value [ns_queryget $key]
# Coerce values to non-negative integers
- if { ![string equal $field ampm] } {
+ if { $field ne "ampm" } {
if { ![regexp {[0-9]+} $value value] } {
set value {}
}
}
# If the value is not null, set it
- if { ![string equal $value {}] } {
+ if { $value ne {} } {
set the_date [template::util::date::set_property $field $the_date $value]
- if { ![string equal $field ampm] } {
+ if { $field ne "ampm" } {
set have_values 1
}
}
@@ -1348,7 +1348,7 @@
set javascriptdate ""
}
- if { [string equal $element(mode) "edit"] } {
+ if {$element(mode) eq "edit"} {
append output "<input type=\"text\" name=\"$element(id)\" size=\"10\" maxlength=\"10\" id=\"$element(id)_input_field\" value=\"[ad_quotehtml $textdate]\" />"
append output "<input type=\"button\" style=\"border-width: 0px; height: 17px; width: 19px; background-image: url('/resources/acs-templating/calendar.gif'); background-repeat: no-repeat; cursor: pointer;\" onclick=\"return showCalendarWithDefault('$element(id)_input_field', '$javascriptdate', '[template::util::textdate_localized_format]');\" />"
} else {
Index: openacs-4/packages/acs-templating/tcl/debug-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/Attic/debug-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-templating/tcl/debug-procs.tcl 21 Aug 2002 18:15:37 -0000 1.3
+++ openacs-4/packages/acs-templating/tcl/debug-procs.tcl 10 Jan 2007 21:22:12 -0000 1.4
@@ -13,7 +13,7 @@
set proc_name [info procs ::template::mtimes::tcl::$file]
set mtime [file mtime $file]
- if { [string equal $proc_name {}] || $mtime != [$proc_name] } {
+ if { $proc_name eq {} || $mtime != [$proc_name] } {
uplevel #0 "source $file"
proc ::template::mtimes::tcl::$file {} "return $mtime"
Index: openacs-4/packages/acs-templating/tcl/doc-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/doc-procs.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/acs-templating/tcl/doc-procs.tcl 29 Jul 2006 23:10:33 -0000 1.5
+++ openacs-4/packages/acs-templating/tcl/doc-procs.tcl 10 Jan 2007 21:22:12 -0000 1.6
@@ -102,7 +102,7 @@
set structure [lindex $info 1]
set comment [lrange $info 2 end]
- if { [string match one* $structure] } {
+ if { [string match "one*" $structure] } {
# directive is a onevalue or onelist. add a row and move on
incr rowcount
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.9 -r1.10
--- openacs-4/packages/acs-templating/tcl/doc-tcl-procs.tcl 1 Nov 2003 08:45:37 -0000 1.9
+++ openacs-4/packages/acs-templating/tcl/doc-tcl-procs.tcl 10 Jan 2007 21:22:12 -0000 1.10
@@ -46,7 +46,7 @@
set see_name [lindex $directive_comments 1]
set url [lindex $directive_comments 2]
- if {$url == "" } {
+ if {$url eq "" } {
switch -exact $type {
namespace {
@@ -57,7 +57,7 @@
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 [expr $name_length - 2]] ""]
+ set see_namespace [join [lrange $split_name 0 [expr {$name_length - 2}]] ""]
set url "[doc::util::dbl_colon_fix $see_namespace].html#[set see_name]"
}
}
@@ -91,9 +91,9 @@
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 [expr [lindex $marker_idx 1] + 1] end]
- set last_index [expr [lindex $marker_idx 1] + $last_index + 1]
+ lappend indices_list [expr {[lindex $marker_idx 0] + $last_index}]
+ set text [string range $text [expr {[lindex $marker_idx 1] + 1}] end]
+ set last_index [expr {[lindex $marker_idx 1] + $last_index + 1}]
}
# check for cases with no markers
@@ -119,7 +119,7 @@
set result_list [list]
# first check for no markers present
- if { $indices_list == "end" } {
+ if { $indices_list eq "end" } {
set text [list $text]
return 0
}
@@ -128,7 +128,7 @@
foreach index $indices_list {
lappend result_list [string range $text $old_index $index]
- set old_index [expr $index + 1]
+ set old_index [expr {$index + 1}]
}
lappend result_list [string range $text $old_index end]
@@ -355,7 +355,7 @@
default "[lrange [lindex $directive_comments 1] 1 end]" \
description "[lrange $directive_comments 2 end]" ]
} else {
- if {$directive_type == "param"} {
+ if {$directive_type eq "param"} {
set default_comment "required"
} else {
set default_comment ""
@@ -430,7 +430,7 @@
set namespace_name [lindex $directive_comments 0]
set namespace_description [lrange $directive_comments 1 end]
- if {$namespace_description != "" } {
+ if {$namespace_description ne "" } {
set has_comments 1
}
}
Index: openacs-4/packages/acs-templating/tcl/element-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/element-procs.tcl,v
diff -u -r1.25 -r1.26
--- openacs-4/packages/acs-templating/tcl/element-procs.tcl 20 Apr 2004 21:13:07 -0000 1.25
+++ openacs-4/packages/acs-templating/tcl/element-procs.tcl 10 Jan 2007 21:22:12 -0000 1.26
@@ -147,7 +147,7 @@
# add the reference to the elements lookup array for the form
upvar #$level $form_id:$element_id opts
- if [info exists opts] {
+ if {[info exists opts]} {
error "Element '$element_id' already exists in form '$form_id'."
}
@@ -175,8 +175,8 @@
# If the widget is a submit widget, remember it
# All submit widgets are optional
- if { [string equal $opts(widget) submit] || \
- [string equal $opts(widget) button] } {
+ if { $opts(widget) eq "submit" || \
+ [string equal $opts(widget) "button"] } {
set form_properties(has_submit) 1
set opts(optional) 1
if { ! [info exists opts(value)] } { set opts(value) $opts(label) }
@@ -202,7 +202,7 @@
}
}
- if { [string equal $opts(widget) hidden]
+ if { [string equal $opts(widget) "hidden"]
&& [info exists opts(sign)]
&& $opts(sign)
} {
@@ -236,7 +236,7 @@
template::util::get_opts $args
- if { [string equal $opts(widget) hidden]
+ if { [string equal $opts(widget) "hidden"]
&& [info exists opts(sign)]
&& $opts(sign)
&& [info exists opts(value)] } {
@@ -370,7 +370,7 @@
set values [list]
# also clobber the value(s) for a submit widget
- if { [string equal $element(widget) submit] } {
+ if {$element(widget) eq "submit"} {
if { [info exists element(value)] } { unset element(value) }
if { [info exists element(values)] } { unset element(values) }
}
@@ -384,13 +384,13 @@
# set a label for use in the template
set label $element(label)
- if { [string equal $label {}] } {
+ if {$label eq {}} {
set label $element(name)
}
# Element shouldn't be validated if it's an inform widget, or the element is not in edit mode.
# The element will be in edit mode if its mode is either blank or set to 'edit'.
- set is_inform [expr [string equal $element(widget) inform] || (![string equal $element(mode) "edit"] && ![string equal $element(mode) ""])]
+ set is_inform [expr {$element(widget) eq "inform" || ($element(mode) ne "edit" && $element(mode) ne "" )}]
# Check for required element
if { ! $is_inform && ! $is_optional && ! [llength $values] } {
@@ -415,7 +415,7 @@
# a single anonymous validation check was specified
set element(validate) [linsert $element(validate) 0 "anonymous"]
- } elseif { [expr $v_length % 3] } {
+ } elseif { [expr {$v_length % 3}] } {
error "Invalid number of parameters to validate option:
$element(validate) (Length is $v_length)"
@@ -432,7 +432,7 @@
# something was submitted, now check if it is valid
- if { $is_optional && [empty_string_p $value] } {
+ if { $is_optional && $value eq "" } {
# This is an optional field and it's empty... skip validation
# (else things like the integer test will fail)
continue
@@ -536,7 +536,7 @@
set transform_proc "::template::data::transform::$datatype"
- if { [string equal [info procs $transform_proc] {}] } {
+ if {[info procs $transform_proc] eq {}} {
set values [ns_querygetall $element(id)]
@@ -607,7 +607,7 @@
# Remember that the element has been rendered already
set element(is_rendered) t
- if { ![string equal $element(mode) "edit"] && [info exists element(display_value)] && ![string equal $element(widget) "hidden"] } {
+ if { $element(mode) ne "edit" && [info exists element(display_value)] && $element(widget) ne "hidden" } {
return "$element(before_html) $element(display_value) $element(after_html)"
} else {
return "[string trim "$element(before_html) [template::widget::$element(widget) element $tag_attributes] $element(after_html)"]"
@@ -665,7 +665,7 @@
upvar #$level formgroup:$i formgroup
- set option [lindex $options [expr $i - 1]]
+ set option [lindex $options [expr {$i - 1}]]
set value [lindex $option 1]
if { ![info exists values($value)] } {
Index: openacs-4/packages/acs-templating/tcl/file-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/file-procs.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-templating/tcl/file-procs.tcl 29 Jul 2006 23:10:33 -0000 1.9
+++ openacs-4/packages/acs-templating/tcl/file-procs.tcl 10 Jan 2007 21:22:12 -0000 1.10
@@ -21,7 +21,7 @@
# Work around Windows bullshit
set filename [ns_queryget $element_id]
- if { [string equal $filename ""] } {
+ if {$filename eq ""} {
return ""
}
Index: openacs-4/packages/acs-templating/tcl/filter-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/filter-procs.tcl,v
diff -u -r1.14 -r1.15
--- openacs-4/packages/acs-templating/tcl/filter-procs.tcl 27 Feb 2005 22:45:40 -0000 1.14
+++ openacs-4/packages/acs-templating/tcl/filter-procs.tcl 10 Jan 2007 21:22:12 -0000 1.15
@@ -27,7 +27,7 @@
set cache_p [lindex $args 0]
- if { [string equal $cache_p "t"] } {
+ if {$cache_p eq "t"} {
set persistent_p [lindex $args 1]
set excluded_vars [lindex $args 2]
Index: openacs-4/packages/acs-templating/tcl/form-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/form-procs.tcl,v
diff -u -r1.32 -r1.33
--- openacs-4/packages/acs-templating/tcl/form-procs.tcl 28 Feb 2005 01:28:25 -0000 1.32
+++ openacs-4/packages/acs-templating/tcl/form-procs.tcl 10 Jan 2007 21:22:12 -0000 1.33
@@ -140,7 +140,7 @@
# check whether this form is being submitted
upvar #$level $id:submission submission
- if { [string equal $id request] } {
+ if {$id eq "request"} {
# request is the magic ID for the form holding query parameters
set submission 1
} else {
@@ -152,7 +152,7 @@
set formbutton [get_button $id]
# If the user hit a button named "cancel", redirect and about
- if { $submission && [string equal $formbutton "cancel"] && [exists_and_not_null opts(cancel_url)]} {
+ if { $submission && $formbutton eq "cancel" && [exists_and_not_null opts(cancel_url)]} {
ad_returnredirect $opts(cancel_url)
ad_script_abort
}
@@ -173,7 +173,7 @@
foreach element [split $element_data "\n"] {
set element [string trim $element]
- if { [string equal $element {}] } { continue }
+ if {$element eq {}} { continue }
eval template::element create $id $element
}
@@ -215,14 +215,14 @@
set formbutton {}
# If the form isn't being submitted at all, no button was clicked
- if { ![string equal $id [ns_queryget form:id]] } {
+ if { $id ne [ns_queryget form:id] } {
return {}
}
# Search the submit form for the button
set form [ns_getform]
- if { ![empty_string_p $form] } {
+ if { $form ne "" } {
set size [ns_set size $form]
for { set i 0 } { $i < $size } { incr i } {
if { [string match "formbutton:*" [ns_set key $form $i]] } {
@@ -257,14 +257,14 @@
set formaction {}
# If the form isn't being submitted at all, there's no action
- if { ![string equal $id [ns_queryget "form:id"]] } {
+ if { $id ne [ns_queryget "form:id"] } {
return {}
}
set formbutton [get_button $id]
# If we were in display mode, and a button was clicked, we should be in edit mode now
- if { [string equal [ns_queryget "form:mode"] "display"] && ![empty_string_p $formbutton] } {
+ if { [string equal [ns_queryget "form:mode"] "display"] && $formbutton ne "" } {
set formaction $formbutton
return $formaction
}
@@ -318,7 +318,7 @@
set "elements:${elements:rowcount}(rownum)" ${elements:rowcount}
}
- if { [string equal $style {}] } {
+ if {$style eq {}} {
set style [parameter::get \
-package_id [ad_conn subsite_id] \
-parameter DefaultFormStyle \
@@ -464,7 +464,7 @@
set label [lindex $button 0]
set name [lindex $button 1]
- if { [string equal $name "ok"] } {
+ if {$name eq "ok"} {
# We hard-code the OK button to be wider than it otherwise would
set label " $label "
}
@@ -481,7 +481,7 @@
# Check if the element has an empty string mode, and in
# that case, set to form mode
- if { [string equal $element(mode) {}] } {
+ if {$element(mode) eq {}} {
set element(mode) $properties(mode)
}
}
@@ -492,7 +492,7 @@
# get a reference by element ID
upvar #$level $element_ref element
- if { [string equal $element(widget) "hidden"] && [exists_and_not_null $id:error($element(id))] } {
+ if { $element(widget) eq "hidden" && [exists_and_not_null $id:error($element(id))] } {
error "Validation error in hidden form element: '[set $id:error($element(id))]' on element '$element(id)'."
}
}
@@ -515,7 +515,7 @@
# append attributes to form tag
foreach name [array names attributes] {
- if { [string equal $attributes($name) {}] } {
+ if {$attributes($name) eq {}} {
append output " $name"
} else {
append output " $name=\"$attributes($name)\""
@@ -529,7 +529,7 @@
# If we're in edit mode, output the action
upvar #$level $id:formaction formaction
- if { [string equal $properties(mode) "edit"] && [exists_and_not_null formaction] } {
+ if { $properties(mode) eq "edit" && [exists_and_not_null formaction] } {
upvar #$level $id:formaction action
append output [export_vars -form { { form\:formaction $formaction } }]
}
@@ -554,10 +554,10 @@
upvar #$level $element_ref element
# Check if the element has been rendered already
- if { [string equal $element(is_rendered) f] } {
+ if {$element(is_rendered) eq "f"} {
# If the element is hidden, render it
- if { [string equal $element(widget) hidden] } {
+ if {$element(widget) eq "hidden"} {
append output [template::element render $id $element(id) {} ]
append output "\n"
@@ -586,7 +586,7 @@
repreparing a form that is returned to the user due to
validation problems
} {
- return [expr ! [is_submission $id]]
+ return [expr {! [is_submission $id]}]
}
ad_proc -public template::form::is_submission { id } {
@@ -766,7 +766,7 @@
form.
} {
set form [ns_getform]
- if { $form == "" } { return "" }
+ if { $form eq "" } { return "" }
set export_data ""
Index: openacs-4/packages/acs-templating/tcl/list-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/list-procs.tcl,v
diff -u -r1.41 -r1.42
--- openacs-4/packages/acs-templating/tcl/list-procs.tcl 15 Dec 2006 00:02:09 -0000 1.41
+++ openacs-4/packages/acs-templating/tcl/list-procs.tcl 10 Jan 2007 21:22:12 -0000 1.42
@@ -91,7 +91,7 @@
}
extended_price {
label "Extended Price"
- display_eval {[lc_sepfmt [expr $quantity $item_price]]}
+ display_eval {[lc_sepfmt [expr {$quantity $item_price}]]}
}
}
@@ -290,7 +290,7 @@
set row_pretty_plural [lang::util::localize $row_pretty_plural]
set no_data [ad_decode $no_data "" [_ acs-templating.No_row_pretty_plural] $no_data]
# Set ulevel to the level of the page, so we can access it later
- set list_properties(ulevel) "\#[expr [info level] - $ulevel]"
+ set list_properties(ulevel) "\#[expr {[info level] - $ulevel}]"
# Set properties from the parameters passed
foreach elm {
@@ -319,18 +319,18 @@
}
# Default 'class' to 'main_class'
- if { [empty_string_p $list_properties(class)] } {
+ if { $list_properties(class) eq "" } {
set list_properties(class) $list_properties(main_class)
}
# Default 'multirow' to list name
- if { [empty_string_p $list_properties(multirow)] } {
+ if { $list_properties(multirow) eq "" } {
set list_properties(multirow) $name
}
# Set up automatic 'checkbox' element as the first element
if { !$has_checkboxes_p && [llength $bulk_actions] > 0 } {
- if { [empty_string_p $key] } {
+ if { $key eq "" } {
error "You cannot have bulk_actions without providing a key"
}
# Create the checkbox element
@@ -386,7 +386,7 @@
set filter_default {}
foreach { orderby_name orderby_spec } $orderby {
- if { [string equal $orderby_name "default_value"] } {
+ if {$orderby_name eq "default_value"} {
set filter_default $orderby_spec
} else {
template::list::orderby::create \
@@ -434,9 +434,9 @@
-spec [list label "[_ acs-templating.Page_Size]" default_value 20 hide_p t]
}
- if { (![empty_string_p $list_properties(page_size)] && $list_properties(page_size) != 0) || $list_properties(page_size_variable_p) == 1 } {
+ if { ($list_properties(page_size) ne "" && $list_properties(page_size) != 0) || $list_properties(page_size_variable_p) == 1 } {
# Check that we have either page_query or page_query_name
- if { [empty_string_p $list_properties(page_query)] && [empty_string_p $list_properties(page_query_name)] } {
+ if { $list_properties(page_query) eq "" && $list_properties(page_query_name) eq "" } {
error "[_ acs-templating.lt_When_specifying_a_non]"
}
@@ -472,7 +472,7 @@
}
# Set the bulk_action_export_chunk
- if { ![empty_string_p $list_properties(bulk_action_export_vars)] } {
+ if { $list_properties(bulk_action_export_vars) ne "" } {
set list_properties(bulk_action_export_chunk) [uplevel $list_properties(ulevel) \
[list export_vars -form $list_properties(bulk_action_export_vars)]]
}
@@ -489,7 +489,7 @@
set list_properties(orderby_selected_name) $orderby_name
- if { [empty_string_p $orderby_direction] } {
+ if { $orderby_direction eq "" } {
template::list::orderby::get_reference \
-list_name $name \
-orderby_name $orderby_name
@@ -502,7 +502,7 @@
# This sets orderby, etc., for filters
prepare_elements \
-name $name \
- -ulevel [expr $ulevel + 1]
+ -ulevel [expr {$ulevel + 1}]
# Make groupby information available to templates
if { [exists_and_not_null list_properties(filter,groupby)] } {
@@ -519,9 +519,9 @@
set list_properties(page_size_export_chunk) [uplevel $list_properties(ulevel) [list export_vars -form -exclude {page_size page} $list_properties(filters_export)]]
}
- if { ![empty_string_p $list_properties(page_size)] && $list_properties(page_size) != 0 } {
+ if { $list_properties(page_size) ne "" && $list_properties(page_size) != 0 } {
- if { [string equal $list_properties(page_query) ""] } {
+ if {$list_properties(page_query) eq ""} {
# We need to uplevel db_map it to get the query from the right context
set list_properties(page_query_substed) \
[uplevel $list_properties(ulevel) [list db_map $list_properties(page_query_name)]]
@@ -538,7 +538,7 @@
set page_size $list_properties(page_size)
set page_group [expr ($page - 1 - (($page - 1) % $groupsize)) / $groupsize + 1]
set first_row [expr ($page_group - 1) * $groupsize * $page_size + 1]
- set last_row [expr $first_row + ($groupsize + 1) * $page_size - 1]
+ set last_row [expr {$first_row + ($groupsize + 1) * $page_size - 1}]
set page_offset [expr ($page_group - 1) * $groupsize]
# Now wrap the provided query with the limit information
@@ -549,7 +549,7 @@
set paginator_name $list_properties(name)
foreach filter $list_properties(filters) {
- if { ![string equal $filter "page"] && [info exists list_properties(filter,$filter)] } {
+ if { $filter ne "page" && [info exists list_properties(filter,$filter)] } {
append paginator_name ",$filter=$list_properties(filter,$filter)"
}
}
@@ -680,7 +680,7 @@
# Get an upvar'd reference to list_properties
get_reference -name $name
- if { [empty_string_p $list_properties(page_size)] || $list_properties(page_size) == 0 } {
+ if { $list_properties(page_size) eq "" || $list_properties(page_size) == 0 } {
return {}
}
@@ -780,7 +780,7 @@
# Get an upvar'd reference to list_properties
get_reference -name $name
- if { [empty_string_p $list_properties(page_size)] || $list_properties(page_size) == 0 } {
+ if { $list_properties(page_size) eq "" || $list_properties(page_size) == 0 } {
return {}
}
@@ -810,7 +810,7 @@
# Get an upvar'd reference to list_properties
get_reference -name $name
- if { [empty_string_p $list_properties(page_size)] || $list_properties(page_size) == 0 } {
+ if { $list_properties(page_size) eq "" || $list_properties(page_size) == 0 } {
return {}
}
@@ -834,15 +834,15 @@
# Get an upvar'd reference to list_properties
get_reference -name $name
- if { [empty_string_p $list_properties(orderby_selected_name)] } {
+ if { $list_properties(orderby_selected_name) eq "" } {
return {}
}
set result {}
template::list::orderby::get_reference -list_name $name -orderby_name $list_properties(orderby_selected_name)
set result $orderby_properties(orderby_$list_properties(orderby_selected_direction))
- if { $orderby_p && ![empty_string_p $result] } {
+ if { $orderby_p && $result ne "" } {
set result "order by $result"
}
@@ -859,14 +859,14 @@
# Get an upvar'd reference to list_properties
get_reference -name $name
- if { [empty_string_p $list_properties(orderby_selected_name)] } {
+ if { $list_properties(orderby_selected_name) eq "" } {
return {}
}
template::list::orderby::get_reference -list_name $name -orderby_name $list_properties(orderby_selected_name)
set result [list]
- if { [string equal $list_properties(orderby_selected_direction) "desc"] } {
+ if {$list_properties(orderby_selected_direction) eq "desc"} {
lappend result "-decreasing"
}
@@ -936,11 +936,11 @@
# Find the list template
#
- if { [string equal $style {}] } {
+ if {$style eq {}} {
set style $list_properties(style)
}
- if { [string equal $style {}] } {
+ if {$style eq {}} {
set style [parameter::get \
-package_id [ad_conn subsite_id] \
-parameter DefaultListStyle \
@@ -980,7 +980,7 @@
# Sort in webserver layer, if requested to do so
set __multirow_cols [template::list::multirow_cols -name $__list_properties(name)]
- if { ![empty_string_p $__multirow_cols] } {
+ if { $__multirow_cols ne "" } {
eval template::multirow sort $__list_properties(multirow) $__multirow_cols
}
@@ -1056,22 +1056,22 @@
if { [exists_and_not_null __element_properties(aggregate)] } {
# Update totals
incr __agg_counter($__element_properties(name))
- if { ![string equal $__element_properties(aggregate) "count"] } {
+ if { $__element_properties(aggregate) ne "count" } {
set __agg_sum($__element_properties(name)) \
- [expr $__agg_sum($__element_properties(name)) + [set $__element_properties(name)]]
+ [expr {$__agg_sum($__element_properties(name)) + [set $__element_properties(name)]}]
}
# Check if the value of the groupby column has changed
if { [exists_and_not_null $__list_properties(groupby)] } {
- if { ![string equal $__last_group_val [set $__list_properties(groupby)]] } {
+ if { $__last_group_val ne [set $__list_properties(groupby)] } {
# Initialize our group counters to 0
set __agg_group_counter($__element_properties(name)) 0
set __agg_group_sum($__element_properties(name)) 0
}
# Update subtotals
incr __agg_group_counter($__element_properties(name))
set __agg_group_sum($__element_properties(name)) \
- [expr $__agg_group_sum($__element_properties(name)) + [set $__element_properties(name)]]
+ [expr {$__agg_group_sum($__element_properties(name)) + [set $__element_properties(name)]}]
}
switch $__element_properties(aggregate) {
@@ -1083,18 +1083,18 @@
}
average {
set $__element_properties(aggregate_col) \
- [expr $__agg_sum($__element_properties(name)) / $__agg_counter($__element_properties(name))]
+ [expr {$__agg_sum($__element_properties(name)) / $__agg_counter($__element_properties(name))}]
if { [exists_and_not_null $__list_properties(groupby)] } {
set $__element_properties(aggregate_group_col) \
- [expr $__agg_sum($__element_properties(name)) / $__agg_group_counter($__element_properties(name))]
+ [expr {$__agg_sum($__element_properties(name)) / $__agg_group_counter($__element_properties(name))}]
}
}
count {
set $__element_properties(aggregate_col) \
- [expr $__agg_counter($__element_properties(name))]
+ [expr {$__agg_counter($__element_properties(name))}]
if { [exists_and_not_null $__list_properties(groupby)] } {
set $__element_properties(aggregate_group_col) \
- [expr $__agg_group_counter($__element_properties(name))]
+ [expr {$__agg_group_counter($__element_properties(name))}]
}
}
default {
@@ -1154,7 +1154,7 @@
template::util::list_to_multirow page_sizes {{name 10 value 10} {name 20 value 20} {name 50 value 50} {name 100 value 100}}
}
- if { ![empty_string_p $list_properties(page_size)] && $list_properties(page_size) != 0 } {
+ if { $list_properties(page_size) ne "" && $list_properties(page_size) != 0 } {
set current_page $list_properties(filter,page)
@@ -1179,7 +1179,7 @@
if 0 {
set num_pages 11
set pages [list]
- for { set i [expr $current_page - $num_pages] } { $i < [expr $current_page + $num_pages] } { incr i } {
+ for { set i [expr {$current_page - $num_pages}] } { $i < [expr {$current_page + $num_pages}] } { incr i } {
if { $i > 0 && $i <= $paginator(page_count) } {
lappend pages $i
}
@@ -1276,9 +1276,9 @@
foreach element_name $list_properties(elements) {
template::list::element::get_reference -list_name $name -element_name $element_name
- if { ![empty_string_p $element_properties(default_direction)] } {
+ if { $element_properties(default_direction) ne "" } {
- if { [string equal $list_properties(orderby_selected_name) $element_name] } {
+ if {$list_properties(orderby_selected_name) eq $element_name} {
# We're currently ordering on this column
set direction [ad_decode $list_properties(orderby_selected_direction) "asc" "desc" "asc"]
set element_properties(orderby_url) [get_url \
@@ -1317,22 +1317,22 @@
upvar $list_properties(ulevel) $filter_properties(name) current_filter_value
# Set to default value if undefined
- if { ![exists_and_not_null current_filter_value] && ![empty_string_p $filter_properties(default_value)] } {
+ if { ![exists_and_not_null current_filter_value] && $filter_properties(default_value) ne "" } {
set current_filter_value $filter_properties(default_value)
}
# Does the filter have a current value?
if { [info exists current_filter_value] } {
# Get the where clause
- if { [empty_string_p $current_filter_value] } {
+ if { $current_filter_value eq "" } {
set search_order { null_where_clause_eval null_where_clause where_clause_eval where_clause }
} else {
set search_order { where_clause_eval where_clause }
}
foreach property $search_order {
- if { ![empty_string_p $filter_properties($property)] } {
+ if { $filter_properties($property) ne "" } {
# We've found a where_clause to include
if { [string match *_eval $property] } {
@@ -1399,15 +1399,15 @@
set selected_p 0
foreach elm $value {
foreach { elm_key elm_value } [lrange $elm 0 1] {}
- if { [string equal $elm_key $filter_properties(name)] } {
+ if {$elm_key eq $filter_properties(name)} {
set selected_p [exists_and_equal current_filter_value $elm_value]
}
}
}
}
lappend filter_properties(selected_p) $selected_p
- set found_selected_p [expr $found_selected_p || $selected_p]
+ set found_selected_p [expr {$found_selected_p || $selected_p}]
if { $selected_p } {
# Remember the filter label
@@ -1440,7 +1440,7 @@
# Handle 'other_label'
if { [exists_and_not_null current_filter_value] && \
!$found_selected_p && \
- ![empty_string_p $filter_properties(other_label)] } {
+ $filter_properties(other_label) ne "" } {
# Add filter entry with the 'other_label'.
lappend filter_properties(values) [list $filter_properties(other_label) {}]
@@ -1499,7 +1499,7 @@
set label $filter_properties(null_label)
}
- if { [string equal $filter_properties(type) "multival"] } {
+ if {$filter_properties(type) eq "multival"} {
# We need to ns_urlencode the name to work
set filter_properties_name [ns_urlencode $filter_properties(name)]
} else {
@@ -1522,7 +1522,7 @@
}
}
- if { [string equal $style {}] } {
+ if {$style eq {}} {
set style [parameter::get \
-package_id [apm_package_id_from_key "acs-templating"] \
-parameter DefaultListFilterStyle \
@@ -1554,7 +1554,7 @@
} {
set output {}
foreach { key value } $html {
- if { ![empty_string_p $value] } {
+ if { $value ne "" } {
append output " [ad_quotehtml $key]=\"[ad_quotehtml $value]\""
} else {
append output " [ad_quotehtml $key]"
@@ -1736,38 +1736,38 @@
-ulevel $ulevel
# Default display_col to element name
- if { [empty_string_p $element_properties(display_col)] } {
+ if { $element_properties(display_col) eq "" } {
set element_properties(display_col) $element_properties(name)
}
# Default csv_col to display_col
- if { [empty_string_p $element_properties(csv_col)] } {
+ if { $element_properties(csv_col) eq "" } {
set element_properties(csv_col) $element_properties(display_col)
}
# Default sub_class to list:sub_class
- if { [empty_string_p $element_properties(sub_class)] } {
+ if { $element_properties(sub_class) eq "" } {
set element_properties(sub_class) $list_properties(sub_class)
}
# Default class to (list:main_class)-(element:sub_class)
- if { [empty_string_p $element_properties(class)] } {
+ if { $element_properties(class) eq "" } {
set element_properties(class) [join [concat $list_properties(main_class) $element_properties(sub_class)] "-"]
}
# Create the orderby filter, if specified
- if { ![empty_string_p $element_properties(orderby)] || ![empty_string_p $element_properties(orderby_asc)] || ![empty_string_p $element_properties(orderby_desc)] } {
+ if { $element_properties(orderby) ne "" || $element_properties(orderby_asc) ne "" || $element_properties(orderby_desc) ne "" } {
set orderby_spec [list]
foreach elm { orderby orderby_asc orderby_desc default_direction label } {
- if { ![empty_string_p $element_properties($elm)] } {
+ if { $element_properties($elm) ne "" } {
lappend orderby_spec $elm $element_properties($elm)
}
}
template::list::orderby::create \
-list_name $list_name \
-orderby_name $element_properties(name) \
- -ulevel [expr $ulevel + 1] \
+ -ulevel [expr {$ulevel + 1}] \
-spec $orderby_spec
}
}
@@ -1927,7 +1927,7 @@
set link_html $element_properties(link_html)
}
- if { ![empty_string_p $link_url] } {
+ if { $link_url ne "" } {
set old_output $output
set output "<if \"$link_url\" not nil><a href=\"$link_url\"[template::list::util_html_to_attributes_string $link_html]>$old_output</a></if><else>$old_output</else>"
@@ -2078,7 +2078,7 @@
-list_name $list_name \
-filter_name $filter_name \
-spec $spec \
- -ulevel [expr $ulevel + 1]
+ -ulevel [expr {$ulevel + 1}]
# This is to be used by the export_vars function
switch $filter_properties(type) {
@@ -2147,7 +2147,7 @@
default_value {
set value [uplevel $ulevel [list subst $value]]
set filter_properties($property) $value
- if { ![empty_string_p $value] } {
+ if { $value ne "" } {
set filter_properties(has_default_p) 1
}
}
@@ -2331,7 +2331,7 @@
switch $key {
row {
# We only care about this for the currently selected format
- if { [string equal $format_name $selected_format] } {
+ if {$format_name eq $selected_format} {
# This is the layout specification for table layouts
set value [uplevel $ulevel [list subst $value]]
@@ -2353,7 +2353,7 @@
-list_name $list_name \
-element_name $element_name \
-spec $spec \
- -ulevel [expr $ulevel + 1]
+ -ulevel [expr {$ulevel + 1}]
# Remember the display order
lappend list_properties(display_elements) $element_name
@@ -2362,7 +2362,7 @@
}
template {
# We only care about this for the currently selected format
- if { [string equal $format_name $selected_format] } {
+ if {$format_name eq $selected_format} {
# All other vars, do an uplevel subst on the value now
set value [uplevel $ulevel [list subst $value]]
set format_properties($key) $value
@@ -2382,28 +2382,28 @@
}
# For the currently selected format, copy some things over to the list properties
- if { [string equal $format_name $selected_format] } {
- if { [empty_string_p $format_properties(style)] } {
+ if {$format_name eq $selected_format} {
+ if { $format_properties(style) eq "" } {
set format_properties(style) $format_properties(layout)
}
# Move style up to the list_properties
- if { ![empty_string_p $format_properties(style)] } {
+ if { $format_properties(style) ne "" } {
set list_properties(style) $format_properties(style)
}
# Move output up to the list_properties
- if { ![empty_string_p $format_properties(output)] } {
+ if { $format_properties(output) ne "" } {
set list_properties(output) $format_properties(output)
}
# Move page_size up to the list_properties
- if { ![empty_string_p $format_properties(page_size)] } {
+ if { $format_properties(page_size) ne "" } {
set list_properties(page_size) $format_properties(page_size)
}
# Move elements up to the list_properties as display_elements
- if { ![empty_string_p $format_properties(elements)] } {
+ if { $format_properties(elements) ne "" } {
set list_properties(display_elements) $format_properties(elements)
}
@@ -2739,7 +2739,7 @@
{-style ""}
} {
- if { [string equal $style {}] } {
+ if {$style eq {}} {
set style [parameter::get \
-package_id [apm_package_id_from_key "acs-templating"] \
-parameter DefaultListFilterStyle \
Index: openacs-4/packages/acs-templating/tcl/mime-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/mime-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-templating/tcl/mime-procs.tcl 27 Feb 2005 22:45:40 -0000 1.6
+++ openacs-4/packages/acs-templating/tcl/mime-procs.tcl 10 Jan 2007 21:22:12 -0000 1.7
@@ -53,7 +53,7 @@
} else {
set mime_type {}
}
- if { [empty_string_p $mime_type] } {
+ if { $mime_type eq "" } {
set mime_type "text/html"
}
Index: openacs-4/packages/acs-templating/tcl/paginator-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/paginator-procs.tcl,v
diff -u -r1.16 -r1.17
--- openacs-4/packages/acs-templating/tcl/paginator-procs.tcl 26 Feb 2005 17:52:21 -0000 1.16
+++ openacs-4/packages/acs-templating/tcl/paginator-procs.tcl 10 Jan 2007 21:22:12 -0000 1.17
@@ -98,8 +98,8 @@
set cache_key $name:$query
set row_ids [cache get $cache_key:row_ids]
- if { ([string equal $row_ids {}] && ![nsv_exists __template_cache_timeout $cache_key]) || ([info exists opts(flush_p)] && [string equal $opts(flush_p) "t"]) } {
- if { [info exists opts(printing_prefs)] && ![empty_string_p $opts(printing_prefs)] } {
+ if { ($row_ids eq {} && ![nsv_exists __template_cache_timeout $cache_key]) || ([info exists opts(flush_p)] && $opts(flush_p) eq "t") } {
+ if { [info exists opts(printing_prefs)] && $opts(printing_prefs) ne "" } {
ReturnHeaders "text/html"
ns_write "
<html>
@@ -108,29 +108,29 @@
ns_write "<title>$title</title>
<meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\">"
set stylesheet [lindex $opts(printing_prefs) 1]
- if { ![empty_string_p $stylesheet] } {
+ if { $stylesheet ne "" } {
ns_write "<link rel=\"stylesheet\" href=\"$stylesheet\" type=\"text/css\">"
}
ns_write "</head>"
ns_write "<body "
set background [lindex $opts(printing_prefs) 2]
- if { ![empty_string_p $background] } {
+ if { $background ne "" } {
ns_write "background=\"$background\""
}
ns_write ">"
set header_file [lindex $opts(printing_prefs) 3]
- if { ![empty_string_p $header_file] } {
+ if { $header_file ne "" } {
ns_write [ns_adp_parse -file $header_file]
}
ns_write [lindex $opts(printing_prefs) 6]
init $statement_name $name $query 1
ns_write [lindex $opts(printing_prefs) 7]
set footer_file [lindex $opts(printing_prefs) 4]
- if { ![empty_string_p $footer_file] } {
+ if { $footer_file ne "" } {
ns_write [ns_adp_parse -file $footer_file]
}
set return_url [lindex $opts(printing_prefs) 5]
- if { ![empty_string_p $return_url] } {
+ if { $return_url ne "" } {
if { [llength $opts(row_ids)]==0 } {
nsv_set __template_cache_timeout $cache_key $opts(timeout)
}
@@ -216,7 +216,7 @@
lappend row_ids [lindex $row 0]
- if { [expr $i % $page_size] == 0 } {
+ if { [expr {$i % $page_size}] == 0 } {
lappend context_ids [lindex $row 1]
}
incr i
@@ -325,7 +325,7 @@
if {$page_count == $pagenum} {
return $properties(row_count)
} else {
- return [expr $pagenum * $properties(pagesize)]
+ return [expr {$pagenum * $properties(pagesize)}]
}
}
@@ -366,7 +366,7 @@
# get the set of ids for the current page
set start [expr ($pagenum - $page_offset - 1) * $pagesize]
- set end [expr $start + $pagesize - 1]
+ set end [expr {$start + $pagesize - 1}]
set ids [lrange $properties(row_ids) $start $end]
return $ids
@@ -408,7 +408,7 @@
}
set start [expr ($group - 1) * $group_size + 1]
- set end [expr $start + $group_size - 1]
+ set end [expr {$start + $group_size - 1}]
if { $end > $page_count } { set end $page_count }
@@ -449,7 +449,7 @@
set first [expr ($group - 1 - (($group - 1) % $count)) / $count + 1]
set start [expr ($first - 1) * $group_size + 1]
- set end [expr $start + $group_size * $page_size - 1]
+ set end [expr {$start + $group_size * $page_size - 1}]
if { $end > $page_count } { set end $page_count) }
@@ -496,7 +496,7 @@
set row(rownum) $rowcount
set row(page) $page
- set row(context) [lindex $context_ids [expr $page - 1]]
+ set row(context) [lindex $context_ids [expr {$page - 1}]]
}
}
@@ -631,11 +631,11 @@
}
if { $page > 1 } {
- set info(previous_page) [expr $page - 1]
+ set info(previous_page) [expr {$page - 1}]
}
if { $page < $properties(page_count) } {
- set info(next_page) [expr $page + 1]
+ set info(next_page) [expr {$page + 1}]
}
@@ -644,14 +644,14 @@
}
if { $group < $properties(group_count) && $groupsize > 1 } {
- set info(next_group) [expr $group * $groupsize + 1]
+ set info(next_group) [expr {$group * $groupsize + 1}]
}
# If the paginator is contextual, set the context
if { [info exists properties(context_ids)] } {
foreach elm { next_page previous_page next_group previous_group } {
if { [exists_and_not_null info($elm)] } {
- set info(${elm}_context) [lindex $properties(context_ids) [expr $info($elm) -1]]
+ set info(${elm}_context) [lindex $properties(context_ids) [expr {$info($elm) -1}]]
}
}
}
@@ -679,7 +679,7 @@
template::util::list_to_lookup $ids row_order
# substitute the current page set
- if { [empty_string_p $query] } {
+ if { $query eq "" } {
set query [uplevel 2 "db_map ${statement_name}_partial"]
}
@@ -744,7 +744,7 @@
} {
set ids [get_row_ids $name $page]
- if { ![empty_string_p $ids] } {
+ if { $ids ne "" } {
# calculate the base row number for the page
upvar 2 __page_firstrow firstrow
set firstrow [get_row $name $page]
Index: openacs-4/packages/acs-templating/tcl/parse-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/parse-procs.tcl,v
diff -u -r1.40 -r1.41
--- openacs-4/packages/acs-templating/tcl/parse-procs.tcl 17 Feb 2006 01:11:42 -0000 1.40
+++ openacs-4/packages/acs-templating/tcl/parse-procs.tcl 10 Jan 2007 21:22:12 -0000 1.41
@@ -51,7 +51,7 @@
# set the stack frame at which the template is being parsed so that
# other procedures can reference variables cleanly
variable parse_level
- lappend parse_level [expr [info level] - $uplevel]
+ lappend parse_level [expr {[info level] - $uplevel}]
set __adp_out [template::adp_parse [template::util::url_to_file $src] $varlist]
@@ -79,7 +79,7 @@
foreach {__key __value} $__args {
if {[string match "&*" $__key]} { # "&" triggers call by reference
- if {[string compare "&" $__key]} {
+ if {"&" ne $__key } {
set __name [string range $__key 1 end]
} else {
set __name $__value
@@ -112,7 +112,7 @@
# and other clever users of the include tag work properly ...
template::util::lpop parse_level
- if { [string equal $errMsg ADP_ABORT] } {
+ if {$errMsg eq "ADP_ABORT"} {
return ""
} else {
global errorInfo errorCode
@@ -280,10 +280,10 @@
# but we need to check it for the case of isolated compilation
if { [info exists parse_level] } {
- if { [string equal $up "" ] } {
+ if {$up eq ""} {
set result [lindex $parse_level end]
} else {
- set result [lindex $parse_level [expr [llength $parse_level] - $up]]
+ set result [lindex $parse_level [expr {[llength $parse_level] - $up}]]
}
}
@@ -324,14 +324,14 @@
# propagate aborting
global request_aborted
- if [info exists request_aborted] {
+ if {[info exists request_aborted]} {
ns_log warning "propagating abortion from $__adp_remember_stub.tcl\
(status [lindex $request_aborted 0]): '[lindex $request_aborted 1]')"
adp_abort
}
# if the file has changed than prepare again
- if { ! [string equal $__adp_stub $__adp_remember_stub] } {
+ if { $__adp_stub ne $__adp_remember_stub } {
adp_prepare; # propagate result up
} { return 1 }
}
@@ -377,10 +377,10 @@
set refresh_cache [ad_parameter -package_id $pkg_id RefreshCache dummy\
"as needed"]
- if {[string equal $proc_name {}] || [string compare $refresh_cache "never"]} {
+ if {$proc_name eq {} || $refresh_cache ne "never" } {
set mtime [file mtime $file_stub.$type]
- if {[string equal $proc_name {}] || $mtime != [$proc_name]
- || [string equal $refresh_cache "always"]} {
+ if {$proc_name eq {} || $mtime != [$proc_name]
+ || $refresh_cache eq "always"} {
# either the procedure does not already exist or is not up-to-date
@@ -436,7 +436,7 @@
while { [regexp [lang::message::embedded_vars_regexp] $remaining_message match before_percent percent_match remaining_message] } {
append formatted_message $before_percent
- if { [string equal $percent_match "%%"] } {
+ if {$percent_match eq "%%"} {
# A quoted percentage sing
set substitution "%"
} else {
@@ -660,7 +660,7 @@
variable parse_list
- if { [string equal $nobreak -nobreak] } {
+ if {$nobreak eq "-nobreak"} {
set last_line [lindex $parse_list end]
append last_line " $code"
@@ -752,13 +752,13 @@
variable tag_stack
- set last [expr [llength $tag_stack] - 2]
+ set last [expr {[llength $tag_stack] - 2}]
for { set i $last } { $i >= 0 } { incr i -1 } {
set pair [lindex $tag_stack $i]
- if { [string equal [lindex $pair 0] $tag] } {
+ if {[lindex $pair 0] eq $tag} {
set name [lindex $pair 1]
break
}
@@ -786,13 +786,13 @@
variable tag_stack
- set last [expr [llength $tag_stack] - 1]
+ set last [expr {[llength $tag_stack] - 1}]
for { set i $last } { $i >= 0 } { incr i -1 } {
set pair [lindex $tag_stack $i]
- if { [string equal [lindex $pair 0] $tag] } {
+ if {[lindex $pair 0] eq $tag} {
set name [ns_set get [lindex $pair 1] name]
break
}
@@ -818,7 +818,7 @@
} {
set value [ns_set iget $params $name]
- if { [string equal $value {}] } {
+ if {$value eq {}} {
if { [string equal $default {ERROR}] } {
error "Missing [string toupper $name] property\
in [string toupper $tag] tag"
Index: openacs-4/packages/acs-templating/tcl/query-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/query-procs.tcl,v
diff -u -r1.26 -r1.27
--- openacs-4/packages/acs-templating/tcl/query-procs.tcl 27 Apr 2004 12:24:30 -0000 1.26
+++ openacs-4/packages/acs-templating/tcl/query-procs.tcl 10 Jan 2007 21:22:12 -0000 1.27
@@ -86,7 +86,7 @@
if { ! [info exists opts(uplevel)] } {
set opts(uplevel) 2
} else {
- set opts(uplevel) [expr 2 + $opts(uplevel)]
+ set opts(uplevel) [expr {2 + $opts(uplevel)}]
}
# check the cache for a valid cached query result and return if so
@@ -137,7 +137,7 @@
set row [db_exec 0or1row $db $statement_name $sql 3]
- if { $row != "" } {
+ if { $row ne "" } {
# Set the result in the calling frame.
set result [ns_set value $row 0]
@@ -165,7 +165,7 @@
set row [db_exec 0or1row $db $statement_name $sql 3]
- if { $row != "" } {
+ if { $row ne "" } {
# Set the results in the calling frame.
upvar $opts(uplevel) $result_name result
@@ -226,7 +226,7 @@
if { [info exists opts(eval)] } {
# figure out the level at which to reference the row
- set ref_level [expr $opts(uplevel) - 2]
+ set ref_level [expr {$opts(uplevel) - 2}]
}
while { [ns_db getrow $db $row] } {
@@ -516,9 +516,9 @@
nsv_set __template_query_persistent_cache $cache_key $opts(result)
if { [info exists opts(timeout)] } {
- set timeout [expr [ns_time] + $opts(timeout)]
+ set timeout [expr {[ns_time] + $opts(timeout)}]
} else {
- set timeout [expr [ns_time] + 60 * 60 * 24 * 7]
+ set timeout [expr {[ns_time] + 60 * 60 * 24 * 7}]
}
nsv_set __template_query_persistent_timeout $cache_key $timeout
@@ -759,7 +759,7 @@
set index [lindex $args 0]
set column [lindex $args 1]
# Set an array reference if no column is specified
- if { [string equal $column {}] } {
+ if {$column eq {}} {
uplevel "upvar $multirow_level_up $name:$index $name"
} else {
# If a column is specified, just return the value for it
@@ -774,7 +774,7 @@
set column [lindex $args 1]
set value [lindex $args 2]
- if { [string equal $column {}] } {
+ if {$column eq {}} {
error "No column specified to template::multirow set"
}
@@ -1083,9 +1083,9 @@
set value [lindex $args 0]
if { [llength $args] == 1 } {
- set timeout [expr [ns_time] + 60 * 60 * 24 * 7]
+ set timeout [expr {[ns_time] + 60 * 60 * 24 * 7}]
} else {
- set timeout [expr [ns_time] + [lindex $args 1]]
+ set timeout [expr {[ns_time] + [lindex $args 1]}]
}
nsv_set __template_cache_value $key $value
Index: openacs-4/packages/acs-templating/tcl/request-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/request-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-templating/tcl/request-procs.tcl 29 Jul 2006 23:10:33 -0000 1.6
+++ openacs-4/packages/acs-templating/tcl/request-procs.tcl 10 Jan 2007 21:22:12 -0000 1.7
@@ -54,7 +54,7 @@
foreach param [split $param_data "\n"] {
set param [string trim $param]
- if { [string equal $param {}] } { continue }
+ if {$param eq {}} { continue }
eval set_param $param
}
@@ -165,9 +165,9 @@
# set requesterror as a data source
uplevel #$level "upvar 0 request:error requesterror"
- if { ! [string equal $url "self"] } {
+ if { $url ne "self" } {
- if { [string equal $url {}] } {
+ if {$url eq {}} {
set file_stub [template::get_resource_path]/messages/request-error
} else {
set file_stub [ns_url2file $url]
Index: openacs-4/packages/acs-templating/tcl/richtext-or-file-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/richtext-or-file-procs.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-templating/tcl/richtext-or-file-procs.tcl 29 Jul 2006 02:01:39 -0000 1.3
+++ openacs-4/packages/acs-templating/tcl/richtext-or-file-procs.tcl 10 Jan 2007 21:22:12 -0000 1.4
@@ -81,15 +81,15 @@
set tmp_filename [lindex $richtext_or_file_list 4]
set content_url [lindex $richtext_or_file_list 5]
- if { ![empty_string_p $text] && [lsearch -exact [template::util::richtext_or_file::formats] $mime_type] == -1 } {
+ if { $text ne "" && [lsearch -exact [template::util::richtext_or_file::formats] $mime_type] == -1 } {
set message "Invalid text format, '$mime_type'."
return 0
}
# enhanced text and HTML needs to be security checked
if { [lsearch { text/enhanced text/html } $mime_type] == -1 } {
set check_result [ad_html_security_check $text]
- if { ![empty_string_p $check_result] } {
+ if { $check_result ne "" } {
set message $check_result
return 0
}
@@ -119,7 +119,7 @@
switch $storage_type {
text {
set text [ns_queryget $element_id.text]
- if { [empty_string_p $text] } {
+ if { $text eq "" } {
return [list]
}
set mime_type [ns_queryget $element_id.mime_type]
@@ -128,7 +128,7 @@
}
file {
set file [template::util::file_transform $element_id.file]
- if { [empty_string_p $file] } {
+ if { $file eq "" } {
return [list]
}
set filename [template::util::file::get_property filename $file]
@@ -287,8 +287,8 @@
set output {}
- if { [string equal $element(mode) "edit"] } {
- if { [empty_string_p $storage_type] } {
+ if {$element(mode) eq "edit"} {
+ if { $storage_type eq "" } {
append output "<input type=\"radio\" name=\"$element(id).storage_type\" id=\"$element(id).storage_type_text\" value=\"text\" "
append output "checked "
append output "onclick=\"javascript:acs_RichText_Or_File_InputMethodChanged('$element(form_id)', '$element(id)', this);\">"
@@ -297,32 +297,32 @@
append output "<input type=\"hidden\" name=\"$element(id).storage_type\" value=\"[ad_quotehtml $storage_type]\">"
}
- if { [empty_string_p $storage_type] || [string equal $storage_type "text"] } {
+ if { $storage_type eq "" || $storage_type eq "text" } {
append output {<script language="javascript"><!--} \n {acs_RichText_WriteButtons(); //--></script>}
append output [textarea_internal "$element(id).text" attributes $text]
append output "<br>Format: [menu "$element(id).mime_type" [template::util::richtext_or_file::format_options] $mime_type attributes]"
}
- if { [empty_string_p $storage_type] } {
+ if { $storage_type eq "" } {
append output "</blockquote>"
append output "<input type=\"radio\" name=\"$element(id).storage_type\" id=\"$element(id).storage_type_file\" value=\"file\" "
append output "onclick=\"javascript:acs_RichText_Or_File_InputMethodChanged('$element(form_id)', '$element(id)', this);\">"
append output "<label for=\"$element(id).storage_type_file\">Upload a file</label>"
append output "<blockquote>"
}
- if { [string equal $storage_type "file"] } {
+ if {$storage_type eq "file"} {
append output [template::util::richtext_or_file::get_property html_value $element(value)]
append output "<p>Replace uploaded file: "
append output "<input type=\"file\" name=\"$element(id).file\">"
}
- if { [empty_string_p $storage_type] } {
+ if { $storage_type eq "" } {
append output "<input type=\"file\" name=\"$element(id).file\" disabled>"
}
- if { [empty_string_p $storage_type] } {
+ if { $storage_type eq "" } {
append output "</blockquote>"
}
} else {
Index: openacs-4/packages/acs-templating/tcl/richtext-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/richtext-procs.tcl,v
diff -u -r1.25 -r1.26
--- openacs-4/packages/acs-templating/tcl/richtext-procs.tcl 18 Aug 2006 19:02:24 -0000 1.25
+++ openacs-4/packages/acs-templating/tcl/richtext-procs.tcl 10 Jan 2007 21:22:12 -0000 1.26
@@ -76,15 +76,15 @@
set contents [lindex $richtext_list 0]
set format [lindex $richtext_list 1]
- if { ![empty_string_p $contents] && [lsearch -exact [template::util::richtext::formats] $format] == -1 } {
+ if { $contents ne "" && [lsearch -exact [template::util::richtext::formats] $format] == -1 } {
set message "Invalid format, '$format'."
return 0
}
# enhanced text and HTML needs to be security checked
if { [lsearch { text/enhanced text/html } $format] != -1 } {
set check_result [ad_html_security_check $contents]
- if { ![empty_string_p $check_result] } {
+ if { $check_result ne "" } {
set message $check_result
return 0
}
@@ -110,7 +110,7 @@
set contents [ns_queryget $element_id]
set format [ns_queryget $element_id.format]
- if { [empty_string_p $contents] } {
+ if { $contents eq "" } {
# We need to return the empty list in order for form builder to think of it
# as a non-value in case of a required element.
return [list]
@@ -174,7 +174,7 @@
return $format
}
html_value {
- if { ![empty_string_p $contents] } {
+ if { $contents ne "" } {
return [ad_html_text_convert -from $format -to "text/html" -- $contents]
} else {
return {}
@@ -221,7 +221,7 @@
set output {}
- if { [string equal $element(mode) "edit"] } {
+ if {$element(mode) eq "edit"} {
append output {<script language="javascript"><!--} \n {acs_RichText_WriteButtons(); //--></script>}
set attributes(id) "richtext__$element(form_id)__$element(id)"
Index: openacs-4/packages/acs-templating/tcl/spellcheck-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/spellcheck-init.tcl,v
diff -u -r1.11 -r1.12
--- openacs-4/packages/acs-templating/tcl/spellcheck-init.tcl 26 Feb 2005 16:00:10 -0000 1.11
+++ openacs-4/packages/acs-templating/tcl/spellcheck-init.tcl 10 Jan 2007 21:22:12 -0000 1.12
@@ -61,7 +61,7 @@
# Build the select options list and filter out unwanted dictionaries.
set wanted_dicts [list {"No" :nospell:}]
-if { [empty_string_p $dicts] } {
+if { $dicts eq "" } {
# Just add the default locale (the empty string will work too).
lappend wanted_dicts [list "Yes" $default_lang]
}
Index: openacs-4/packages/acs-templating/tcl/spellcheck-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/spellcheck-procs.tcl,v
diff -u -r1.16 -r1.17
--- openacs-4/packages/acs-templating/tcl/spellcheck-procs.tcl 29 Jul 2006 23:10:33 -0000 1.16
+++ openacs-4/packages/acs-templating/tcl/spellcheck-procs.tcl 10 Jan 2007 21:22:12 -0000 1.17
@@ -27,7 +27,7 @@
set merge_text [ns_set get $__form__ $element_id.merge_text]
ns_set delkey $__form__ $element_id.merge_text
- if { [empty_string_p $merge_text] } {
+ if { $merge_text eq "" } {
return {}
}
@@ -64,19 +64,19 @@
if { [set richtext_p [string equal "richtext" $element(datatype)]] } {
# special treatment for the "richtext" datatype.
set format [template::util::richtext::get_property format [lindex $values 0]]
- if { ![empty_string_p $merge_text] } {
+ if { $merge_text ne "" } {
set richtext_value [lindex [template::data::transform::richtext element] 0]
return [list [template::util::richtext::set_property contents $richtext_value $merge_text]]
}
set contents [template::util::richtext::get_property contents [lindex $values 0]]
} else {
- if { ![empty_string_p $merge_text] } {
+ if { $merge_text ne "" } {
return [list $merge_text]
}
set contents [lindex $values 0]
}
- if { [empty_string_p $contents] } {
+ if { $contents eq "" } {
return $values
}
# if language is empty string don't spellcheck
@@ -145,7 +145,7 @@
set old_element "XXinitial_conditionXX"
foreach list_element $sorted_list {
- if { ![string equal $list_element $old_element] } {
+ if { $list_element ne $old_element } {
lappend new_list $list_element
}
set old_element $list_element
@@ -204,7 +204,7 @@
# the --lang switch only works with aspell and if it is not present
# aspell's (or ispell's) default language will have to do.
- if { ![empty_string_p $language] } {
+ if { $language ne "" } {
set language "--lang=$language"
}
@@ -294,9 +294,9 @@
foreach { errtype errnum errword erroptions } $error_list {
set wordlen [string length $errword]
- if { [string equal "miss" $errtype] } {
+ if {"miss" eq $errtype} {
regsub "\#$errnum\#" $formtext "<input type=\"text\" name=\"${var_to_spellcheck}.error_$errnum\" value=\"$errword\" size=\"$wordlen\" />" formtext
- } elseif { [string equal "nearmiss" $errtype] } {
+ } elseif {"nearmiss" eq $errtype} {
regsub -all ", " $erroptions "," erroptions
set options [split $erroptions ","]
set select_text "<select name=\"${var_to_spellcheck}.error_$errnum\">\n<option value=\"$errword\">$errword</option>\n"
@@ -330,7 +330,7 @@
# just_the_errwords
####
- if { ![empty_string_p $just_the_errwords_ref]} {
+ if { $just_the_errwords_ref ne ""} {
upvar $just_the_errwords_ref just_the_errwords
@@ -370,9 +370,9 @@
-parameter SpellcheckFormWidgets \
-default ""]]
- set spellcheck_p [expr [array size widget_info] \
- && ([string equal $element(widget) "richtext"] || [string equal $element(widget) "textarea"] || [string equal $element(widget) "text"]) \
- && [lsearch -exact [array names widget_info] $element(widget)] != -1]
+ set spellcheck_p [expr {[array size widget_info] \
+ && ($element(widget) eq "richtext" || $element(widget) eq "textarea" || $element(widget) eq "text") \
+ && [lsearch -exact [array names widget_info] $element(widget)] != -1}]
}
@@ -409,7 +409,7 @@
set spellcheck(selected_option) $spellcheck_value
set spellcheck(render_p) 1
- if { [string equal ":nospell:" $spellcheck(selected_option)] } {
+ if {":nospell:" eq $spellcheck(selected_option)} {
set spellcheck(perform_p) 0
} else {
set spellcheck(perform_p) 1
Index: openacs-4/packages/acs-templating/tcl/tab-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/tab-procs.tcl,v
diff -u -r1.4 -r1.5
--- openacs-4/packages/acs-templating/tcl/tab-procs.tcl 29 Jul 2006 23:10:33 -0000 1.4
+++ openacs-4/packages/acs-templating/tcl/tab-procs.tcl 10 Jan 2007 21:22:12 -0000 1.5
@@ -152,7 +152,7 @@
lappend code -template $template
- if { [string equal $properties(current_tab) $name] } {
+ if {$properties(current_tab) eq $name} {
lappend code -current 1
} else {
lappend code -current 0
@@ -217,12 +217,12 @@
upvar 0 \"$id:properties\" form_properties"
# Change the default style if no style is specified
- if { [string equal [ns_set iget $params style] ""] } {
+ if {[ns_set iget $params style] eq ""} {
ns_set update $params style tabbed-dialog
}
# Render the template
- if { [string equal [string trim $chunk] {}] } {
+ if {[string trim $chunk] eq {}} {
# generate the form body dynamically if none specified.
set style [ns_set iget $params style]
if { [template::util::is_nil style] } {
@@ -257,12 +257,12 @@
upvar 0 \"$id:properties\" form_properties"
# Change the default style if no style is specified
- if { [string equal [ns_set iget $params style] ""] } {
+ if {[ns_set iget $params style] eq ""} {
ns_set update $params style tabbed-dialog
}
# Render the template
- if { [string equal [string trim $chunk] {}] } {
+ if {[string trim $chunk] eq {}} {
# generate the form body dynamically if none specified.
set style [ns_set iget $params style]
if { [template::util::is_nil style] } {
Index: openacs-4/packages/acs-templating/tcl/table-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/table-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-templating/tcl/table-procs.tcl 29 Jul 2006 02:01:39 -0000 1.6
+++ openacs-4/packages/acs-templating/tcl/table-procs.tcl 10 Jan 2007 21:22:12 -0000 1.7
@@ -150,7 +150,7 @@
"
# Append to the row html
- if { ![string equal $presentation ""] } {
+ if { $presentation ne "" } {
# Debug !
regsub -all {"} $presentation {\\"} presentation
append eval_code "set row($row_key) \"$presentation\"\n"
@@ -175,13 +175,13 @@
# Get the column definition if it does not exist
if { [template::util::is_nil widget(column_def)] } {
template::widget::table::default_column_def widget \
- [expr $level + 1]
+ [expr {$level + 1}]
}
} else {
uplevel $level "uplevel 0 tw_${name}_rows $widget(rows_data)"
template::widget::table::default_column_def widget \
- [expr $level + 1]
+ [expr {$level + 1}]
}
# Process the rows datasource and get the columns
@@ -194,7 +194,7 @@
set the_joiner "?"
if { ![template::util::is_nil $the_form] } {
foreach key [ns_set keys $the_form] {
- if { ![string equal $key "tablewidget:${name}_orderby"] } {
+ if { $key ne "tablewidget:${name}_orderby" } {
append url "${the_joiner}${key}\=[ns_set get $the_form $key]"
set the_joiner "&"
}
@@ -211,11 +211,11 @@
set row(name) $column_name
set label [lindex $column 0]
- if { [string equal $label {}] } {
+ if {$label eq {}} {
set label $column_name
}
set orderby_clause [lindex $column 1]
- if { [string equal $orderby_clause {}] } {
+ if {$orderby_clause eq {}} {
set orderby_clause $column_name
}
Index: openacs-4/packages/acs-templating/tcl/tag-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/tag-init.tcl,v
diff -u -r1.25 -r1.26
--- openacs-4/packages/acs-templating/tcl/tag-init.tcl 10 Oct 2005 14:15:41 -0000 1.25
+++ openacs-4/packages/acs-templating/tcl/tag-init.tcl 10 Jan 2007 21:22:12 -0000 1.26
@@ -59,7 +59,7 @@
}
# default to the site-wide master
- if {[empty_string_p $src]} {
+ if {$src eq ""} {
set src "\[ad_parameter -package_id \[ad_conn subsite_id\]\
DefaultMaster dummy \"/www/default-master\"\]"
}
@@ -110,7 +110,7 @@
for { set i 0 } { $i < [ns_set size $params] } { incr i } {
set key [ns_set key $params $i]
- if { [string equal $key src] } { continue }
+ if {$key eq "src"} { continue }
set value [ns_set value $params $i]
@@ -165,10 +165,10 @@
upvar 0 $name __${tag_id}_swap
}
- for { set $i [expr 1 + $startrow] } { \$$i <= \${$name:rowcount}"
+ for { set $i [expr {1 + $startrow}] } { \$$i <= \${$name:rowcount}"
if {$maxrows >= 0} {
- template::adp_append_code " && \$$i <= [expr $maxrows + $startrow]" \
+ template::adp_append_code " && \$$i <= [expr {$maxrows + $startrow}]" \
-nobreak
}
@@ -177,11 +177,11 @@
" -nobreak
template::adp_compile_chunk $chunk
- if { ![empty_string_p $delimiter] } {
+ if { $delimiter ne "" } {
template::adp_append_code " if { \$$i < \${$name:rowcount}"
if {$maxrows >= 0} {
- template::adp_append_code " && \$$i < [expr $maxrows + $startrow]" \
+ template::adp_append_code " && \$$i < [expr {$maxrows + $startrow}]" \
-nobreak
}
@@ -211,7 +211,7 @@
if { ![template::util::is_nil value] } {
set name [ns_set iget $params name]
- if { [empty_string_p $name] } {
+ if { $name eq "" } {
set name "__ats_list_value"
}
@@ -248,7 +248,7 @@
set multiple_tag_id [template::enclosing_tag multiple]
- if { [string equal $multiple_tag_id {}] } {
+ if {$multiple_tag_id eq {}} {
error "No enclosing MULTIPLE tag for GROUP tag on column $column"
}
@@ -266,7 +266,7 @@
# for group tags that have other group tags inside them, since we can't know
# if we're the last row until the inner group tag has eaten up all the
# rows between the start of this tag and the end.
- if { ![empty_string_p $group_tag_id] } {
+ if { $group_tag_id ne "" } {
template::adp_append_code "
if { \[info exists ${name}(groupnum)\] } {
set __${tag_id}_${group_tag_id}_groupnum \$${name}(groupnum)
@@ -303,7 +303,7 @@
}
"
- if { ![empty_string_p $delimiter] } {
+ if { $delimiter ne "" } {
template::adp_append_string $delimiter
}
@@ -315,7 +315,7 @@
"
# Restore saved groupnum pseudocolumns
- if { ![empty_string_p $group_tag_id] } {
+ if { $group_tag_id ne "" } {
template::adp_append_code "
if { \[info exists __${tag_id}_${group_tag_id}_groupnum\] } {
set ${name}(groupnum) \$__${tag_id}_${group_tag_id}_groupnum
@@ -336,18 +336,18 @@
set orientation [template::get_attribute grid $params orientation vertical]
template::adp_append_code "
- set rows \[expr ceil(\${$name:rowcount} / $cols.0)\]
+ set rows \[expr {ceil(\${$name:rowcount} / $cols.0)}\]
for { set __r 1 } { \$__r <= \$rows } { incr __r } {
for { set __c 1 } { \$__c <= $cols } { incr __c } {
"
- if { [string equal $orientation vertical] } {
+ if {$orientation eq "vertical"} {
template::adp_append_code "
- set rownum \[expr 1 + int((\$__r - 1) + ((\$__c - 1) * \$rows))\]
+ set rownum \[expr {1 + int((\$__r - 1) + ((\$__c - 1) * \$rows))}\]
"
} else {
template::adp_append_code "
- set rownum \[expr 1 + int((\$__c - 1) + ((\$__r - 1) * $cols))\]
+ set rownum \[expr {1 + int((\$__c - 1) + ((\$__r - 1) * $cols))}\]
"
}
@@ -431,7 +431,7 @@
set id [template::get_attribute formwidget $params id]
set type [ns_set get $params type]
- if { [string equal $type {}] } {
+ if {$type eq {}} {
set key $id
} else {
set key $id:$type
@@ -442,7 +442,7 @@
set formerror($id) \$formerror($key)
"
- if { [string equal $chunk {}] } {
+ if {$chunk eq {}} {
template::adp_append_string "\$formerror($key)"
@@ -516,7 +516,7 @@
template::adp_append_string \
"\[template::form render $id { $tag_attributes } \]"
- if { [string equal [string trim $chunk] {}] } {
+ if {[string trim $chunk] eq {}} {
# generate the form body dynamically if none specified.
set style [ns_set iget $params style]
@@ -625,7 +625,7 @@
for { set i 0 } { $i < [ns_set size $params] } { incr i } {
set key [ns_set key $params $i]
- if { [string equal $key src] } {
+ if {$key eq "src"} {
continue
}
set value [ns_set value $params $i]
@@ -757,9 +757,9 @@
set key [ns_set key $params $i]
set value [ns_set value $params $i]
- if { [string equal $key $value] } {
+ if {$key eq $value} {
set arg $key
- } elseif [string equal $key flag] {
+ } elseif {$key eq "flag"} {
append sw " -$value "
}
}
@@ -782,7 +782,7 @@
# Scan the parameter stack backward, looking for the tag name
set tag_id [template::enclosing_tag switch]
- if { [string equal $tag_id {}] } {
+ if {$tag_id eq {}} {
error "No enclosing SWITCH tag for CASE tag on value $value"
}
@@ -792,7 +792,7 @@
# insert the case statement and eval the chunk in between
- if { ![string equal $value ""] } {
+ if { $value ne "" } {
# processing <case value= ...> form
@@ -808,7 +808,7 @@
set switches ""
set size [ns_set size $params]
- set size_1 [expr $size - 1]
+ set size_1 [expr {$size - 1}]
for { set i 0 } { $i < $size } { incr i } {
@@ -818,13 +818,13 @@
# pass over the first arg (syntax sugar), but check format
if { $i == 0 } {
- if ![string equal $key "in"] {
+ if {$key ne "in" } {
error "Format error: should be <case in \"foo\" \"bar\" ...>"
}
} else {
- if { [string equal $key $value] } {
+ if {$key eq $value} {
# last item in list so process the chunk
if { $i == $size_1 } {
@@ -856,7 +856,7 @@
# Scan the parameter stack backward, looking for the tag name
set tag_id [template::enclosing_tag switch]
- if { [string equal $tag_id {}] } {
+ if {$tag_id eq {}} {
error "No enclosing SWITCH tag for DEFAULT tag"
}
Index: openacs-4/packages/acs-templating/tcl/tag-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/tag-procs.tcl,v
diff -u -r1.14 -r1.15
--- openacs-4/packages/acs-templating/tcl/tag-procs.tcl 16 Mar 2005 19:19:17 -0000 1.14
+++ openacs-4/packages/acs-templating/tcl/tag-procs.tcl 10 Jan 2007 21:22:12 -0000 1.15
@@ -74,7 +74,7 @@
for { set i 0 } { $i < $size } { incr i } {
set key [ns_set key $params $i]
set value [ns_set value $params $i]
- if { [string equal $key $value] } {
+ if {$key eq $value} {
lappend tokens $key
} else {
lappend tokens "$key=$value"
@@ -101,7 +101,7 @@
set op [lindex $args 1]
- if { $op == "not" } {
+ if { $op eq "not" } {
append condition "! ("
set close_paren ")"
set op [lindex $args 2]
@@ -119,27 +119,27 @@
gt {
append condition "$arg1 > \"[lindex $args $i]\""
- set next [expr $i + 1]
+ set next [expr {$i + 1}]
}
ge {
append condition "$arg1 >= \"[lindex $args $i]\""
- set next [expr $i + 1]
+ set next [expr {$i + 1}]
}
lt {
append condition "$arg1 < \"[lindex $args $i]\""
- set next [expr $i + 1]
+ set next [expr {$i + 1}]
}
le {
append condition "$arg1 <= \"[lindex $args $i]\""
- set next [expr $i + 1]
+ set next [expr {$i + 1}]
}
eq {
append condition "\[string equal $arg1 \"[lindex $args $i]\"\]"
- set next [expr $i + 1]
+ set next [expr {$i + 1}]
}
ne {
append condition "! \[string equal $arg1 \"[lindex $args $i]\"\]"
- set next [expr $i + 1]
+ set next [expr {$i + 1}]
}
in {
@@ -150,9 +150,9 @@
between {
set expr1 "$arg1 >= \"[lindex $args $i]\""
- set expr2 "$arg1 <= \"[lindex $args [expr $i + 1]]\""
+ set expr2 "$arg1 <= \"[lindex $args [expr {$i + 1}]]\""
append condition "($expr1 && $expr2)"
- set next [expr $i + 2]
+ set next [expr {$i + 2}]
}
nil {
@@ -182,12 +182,12 @@
}
odd {
- append condition "\[expr $arg1 % 2\]"
+ append condition "\[expr {$arg1 % 2}\]"
set next $i
}
even {
- append condition "! \[expr $arg1 % 2\]"
+ append condition "! \[expr {$arg1 % 2}\]"
set next $i
}
@@ -204,7 +204,7 @@
default {
# treat <if @foo_p@> as a shortcut for <if @foo_p@ true>
append condition "\[template::util::is_true $arg1\]"
- set next [expr $i - 1]
+ set next [expr {$i - 1}]
}
}
Index: openacs-4/packages/acs-templating/tcl/util-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/util-procs.tcl,v
diff -u -r1.24 -r1.25
--- openacs-4/packages/acs-templating/tcl/util-procs.tcl 29 Jul 2006 23:10:33 -0000 1.24
+++ openacs-4/packages/acs-templating/tcl/util-procs.tcl 10 Jan 2007 21:22:12 -0000 1.25
@@ -38,7 +38,7 @@
# Get the next arg
set next [lindex $argv [incr i]]
- if { ! [string equal [string index $next 0] "-"] ||
+ if { [string index $next 0] ne "-" ||
! [regexp {[a-zA-Z*]} [string index $next 1] match] } {
# the next arg was not a switch so assume it is a parameter
@@ -91,7 +91,7 @@
# check for an array as well
if { [array exists var] } { return 0 }
- if { [info exists var] && ! [string equal $var {}] } {
+ if { [info exists var] && $var ne {} } {
set result 0
} else {
set result 1
@@ -123,7 +123,7 @@
set count [db_string get_count $query]
- return [expr $count == 0]
+ return [expr {$count == 0}]
}
ad_proc -public template::util::is_true { x } {
@@ -146,7 +146,7 @@
upvar $ref the_list
- set the_list [lrange $the_list 0 [expr [llength $the_list] - 2]]
+ set the_list [lrange $the_list 0 [expr {[llength $the_list] - 2}]]
}
ad_proc -public template::util::lnest { listref value next args } {
@@ -462,7 +462,7 @@
set output_charset [ns_config "ns/parameters" OutputCharset]
set tcl_charset [ns_encodingforcharset $output_charset]
- if { ![empty_string_p $tcl_charset] } {
+ if { $tcl_charset ne "" } {
fconfigure $file_channel_id -encoding $tcl_charset
}
}
@@ -488,7 +488,7 @@
Resolve a URL into an absolute file path.
} {
- if { [string index $url 0] != "/" } {
+ if { [string index $url 0] ne "/" } {
set path [file dirname $reference_url]/$url
@@ -518,13 +518,13 @@
} {
set directory $url
- set lastchar [string range $url [expr [string length $url]-1] end]
+ set lastchar [string range $url [expr {[string length $url]-1}] end]
- if {! [string equal $lastchar /]} {
+ if {$lastchar ne "/" } {
set directory [file dirname $url]/
- if { [string equal $directory //] } {
+ if {$directory eq "//"} {
# root directory is a special case
set directory /
}
@@ -573,7 +573,7 @@
default {
- set time [expr [ns_time] + ($expire_state * 60)]
+ set time [expr {[ns_time] + ($expire_state * 60)}]
append cookie ";expires=[ns_httptime $time]"
}
}
@@ -690,7 +690,7 @@
}
set value [ns_config $section $key ""]
- if { [string equal $value ""] } {
+ if {$value eq ""} {
return ""
} else {
# Cache the value and return it
@@ -766,17 +766,17 @@
} {
set varlist ""
- foreach i [if $level {
+ foreach i [if {$level} {
uplevel \#$level {info locals}
} else {info globals} ] {
append varlist " <li><b>$i</b> = "
- if {[string equal $i page] && $level == [info level]-1 ||
- [string equal $i "__adp_output"] || [string equal $i "errorInfo"]} {
+ if {$i eq "page" && $level == [info level]-1 ||
+ $i eq "__adp_output" || $i eq "errorInfo"} {
append varlist "<em>value withheld to avoid messy page</em>\n"
} elseif {[string match -nocase "*secret*" $i]} {
append varlist "<em>value withheld as the name contains \"secret\"</em>\n"
} else {
- if [uplevel \#$level array exists $i] {
+ if {[uplevel \#$level array exists $i]} {
append varlist "<em>ARRAY</em><ul>\n"
foreach {key value} [uplevel \#$level array get $i] {
append varlist " <li><b>$key</b> = '$value'\n"
Index: openacs-4/packages/acs-templating/tcl/widget-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/widget-procs.tcl,v
diff -u -r1.43 -r1.44
--- openacs-4/packages/acs-templating/tcl/widget-procs.tcl 29 Oct 2006 14:05:56 -0000 1.43
+++ openacs-4/packages/acs-templating/tcl/widget-procs.tcl 10 Jan 2007 21:22:12 -0000 1.44
@@ -116,7 +116,7 @@
set value [string trim [ns_queryget $element_id]]
set is_optional [info exists element(optional)]
- if { [empty_string_p $value] } {
+ if { $value eq "" } {
if { [string is true $is_optional] } {
return ""
} else {
@@ -125,7 +125,7 @@
}
}
- if { [string equal $value ":search:"] } {
+ if {$value eq ":search:"} {
# user has selected 'search again' previously
template::element::set_error $element(form_id) $element_id "Please enter a search string."
return [list]
@@ -288,7 +288,7 @@
# Spell-checker
array set spellcheck [template::util::spellcheck::spellcheck_properties -element_ref element]
- if { [string equal $element(mode) "edit"] && $spellcheck(render_p) } {
+ if { $element(mode) eq "edit" && $spellcheck(render_p) } {
append output "<br>[_ acs-templating.Spellcheck]:
[menu "$element(id).spellcheck" [nsv_get spellchecker lang_options] $spellcheck(selected_option) {}]"
}
@@ -316,16 +316,16 @@
} {
upvar $attribute_reference attributes
- if { ![string equal $mode "edit"] } {
+ if { $mode ne "edit" } {
set output {}
- if { ![empty_string_p $value] } {
+ if { $value ne "" } {
append output "[ad_quotehtml $value]<input type=\"hidden\" name=\"$name\" value=\"[ad_quotehtml $value]\">"
}
} else {
set output "<textarea name=\"$name\""
foreach attribute_name [array names attributes] {
- if { [string equal $attributes($attribute_name) {}] } {
+ if {$attributes($attribute_name) eq {}} {
append output " $attribute_name"
} else {
append output " $attribute_name=\"$attributes($attribute_name)\""
@@ -375,13 +375,13 @@
array set attributes $tag_attributes
- if { ( [string equal $type "checkbox"] || [string equal $type "radio"] ) && [info exists element(value)] } {
+ if { ( $type eq "checkbox" || $type eq "radio" ) && [info exists element(value)] } {
# This can be used in the form template in a <label for="id">...</label> tag.
set attributes(id) "$element(form_id):elements:$element(name):$element(value)"
}
# Handle display mode of visible normal form elements, i.e. not hidden, not submit, not button, not clear
- if { ![string equal $element(mode) "edit"] && [lsearch -exact { hidden submit button clear checkbox radio } $type] == -1 } {
+ if { $element(mode) ne "edit" && [lsearch -exact { hidden submit button clear checkbox radio } $type] == -1 } {
set output ""
if { [info exists element(value)] } {
append output [ad_quotehtml $element(value)]
@@ -390,7 +390,7 @@
} else {
set output "<input type=\"$type\" name=\"$element(name)\""
- if { ![string equal $element(mode) "edit"] && [lsearch -exact { hidden submit button clear } $type] == -1 } {
+ if { $element(mode) ne "edit" && [lsearch -exact { hidden submit button clear } $type] == -1 } {
append output " disabled"
}
@@ -399,7 +399,7 @@
}
foreach name [array names attributes] {
- if { [string equal $attributes($name) {}] } {
+ if {$attributes($name) eq {}} {
append output " $name"
} else {
append output " $name=\"$attributes($name)\""
@@ -434,7 +434,7 @@
# Spell-checker
array set spellcheck [template::util::spellcheck::spellcheck_properties -element_ref element]
- if { [string equal $element(mode) "edit"] && $spellcheck(render_p) } {
+ if { $element(mode) eq "edit" && $spellcheck(render_p) } {
return "[input text element $tag_attributes] <br>[_ acs-templating.Spellcheck]:
[menu "$element(id).spellcheck" [nsv_get spellchecker lang_options] $spellcheck(selected_option) {}]"
} else {
@@ -622,7 +622,7 @@
template::util::list_to_lookup $values_list values
set output {}
- if { ![string equal $mode "edit"] } {
+ if { $mode ne "edit" } {
set selected_list [list]
foreach option $options_list {
@@ -661,7 +661,7 @@
append output "<select name=\"$widget_name\" "
foreach name [array names attributes] {
- if { [string equal $attributes($name) {}] } {
+ if {$attributes($name) eq {}} {
append output " $name=\"$name\""
} else {
append output " $name=\"$attributes($name)\""
@@ -766,9 +766,9 @@
# there will no value for the initial request or if the form
# is submitted with no search criteria (text box blank)
- if { [string equal $value {}] } { return [list] }
+ if {$value eq {}} { return [list] }
- if { [string equal $value ":search:"] } {
+ if {$value eq ":search:"} {
if { [info exists element(options)] } {
unset element(options)
}
@@ -852,7 +852,7 @@
append output "$element(history)"
}
- if { [string equal $element(mode) "edit"] } {
+ if {$element(mode) eq "edit"} {
if { [info exists element(header)] } {
append output "<p><b>$element(header)</b></p>"
}
@@ -902,7 +902,7 @@
foreach answer_desc $option {
set answer_description [lindex $answer_desc 0]
set no_of_answers [lindex $answer_desc 1]
- append output "<th colspan=\"[expr $no_of_answers + 1]\" align=\"center\">$answer_description</td>"
+ append output "<th colspan=\"[expr {$no_of_answers + 1}]\" align=\"center\">$answer_description</td>"
}
append output "</tr>"
} elseif {$count == 1} {
Index: openacs-4/packages/acs-templating/tcl/wizard-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/wizard-procs.tcl,v
diff -u -r1.9 -r1.10
--- openacs-4/packages/acs-templating/tcl/wizard-procs.tcl 13 Jan 2004 09:26:08 -0000 1.9
+++ openacs-4/packages/acs-templating/tcl/wizard-procs.tcl 10 Jan 2007 21:22:12 -0000 1.10
@@ -109,7 +109,7 @@
foreach step [split $step_data "\n"] {
set step [string trim $step]
- if { [string equal $step {}] } { continue }
+ if {$step eq {}} { continue }
eval add $step
}
@@ -228,7 +228,7 @@
upvar #$level wizard:current_id current_id
set current_id [ns_queryget wizard_step${wizard_name} {}]
- if { [empty_string_p $current_id] } {
+ if { $current_id eq "" } {
if { [info exists start] } {
set current_id $start
} else {
@@ -241,7 +241,7 @@
# if there is no step state, we are likely in the first step.
# lets redirect with the proper state vars
- if {[string equal [ns_queryget wizard_step${wizard_name}] ""]} {
+ if {[ns_queryget wizard_step${wizard_name}] eq ""} {
template::forward [get_forward_url $current_id]
}
@@ -251,7 +251,7 @@
upvar #$level wizard:current_url current_url
# lets see if this step exists, if not we are finished with wizard and pass the steps
- if [info exists step(url)] {
+ if {[info exists step(url)]} {
set current_url $step(url)
} else {
# if we have set_finish_url then we redirect to that url when we are finished
@@ -265,7 +265,7 @@
set wizard_name $parent_wizard
# lets now increment step of the parent wizard
- set parent_step [expr [ns_queryget wizard_step${parent_wizard}] + 1]
+ set parent_step [expr {[ns_queryget wizard_step${parent_wizard}] + 1}]
template::forward [get_forward_url $parent_step]
}
@@ -274,9 +274,9 @@
# check for a "back" submission and forward immediately if so
# also check if we are backing up the current wizard or another wizard
- if { [ns_queryexists wizard_submit_back] && [string equal $wizard_name [ns_queryget wizard_name]]} {
+ if { [ns_queryexists wizard_submit_back] && $wizard_name eq [ns_queryget wizard_name]} {
- set last_index [expr [lsearch -exact $steps $current_id] - 1]
+ set last_index [expr {[lsearch -exact $steps $current_id] - 1}]
set last_id [lindex $steps $last_index]
# LARS: I removed this, because it causes forms to not save their changes when you hit the back button
@@ -312,7 +312,7 @@
# otherwise we keep the current value
set last_visitedstep [get_param wizard_visitedstep${wizard_name}]
set current_step [current_step]
- if { ($last_visitedstep < $current_step) || [string equal $last_visitedstep ""] } {
+ if { ($last_visitedstep < $current_step) || $last_visitedstep eq "" } {
return $current_step
} else {
return $last_visitedstep
@@ -350,12 +350,12 @@
@see template::wizard
} {
variable parse_level
- set level [expr $parse_level - 1]
+ set level [expr {$parse_level - 1}]
set levels {}
- for {set i $level} {$i > 1} {set i [expr $i - 1]} {
+ for {set i $level} {$i > 1} {set i [expr {$i - 1}]} {
upvar #$i wizard:name parent_wizard
- if [info exists parent_wizard] {
+ if {[info exists parent_wizard]} {
lappend levels $i
} else {
break
@@ -378,7 +378,7 @@
foreach i $levels {
upvar #$i wizard:name parent_wizard
- if [info exists parent_wizard] {
+ if {[info exists parent_wizard]} {
lappend wizards $parent_wizard
}
}
@@ -440,7 +440,7 @@
template::element create $form_id wizard_step${wizard_name} -widget hidden -value $current_id -datatype keyword
- set step_index [expr [lsearch -exact $steps $current_id] + 1]
+ set step_index [expr {[lsearch -exact $steps $current_id] + 1}]
# If not the first one and it is allowed than add a "Back" button
if { $step_index > 1 && [info exists button_labels(back)] } {
@@ -555,7 +555,7 @@
get_reference
upvar #$level wizard:current_id current_id
- set current_index [expr [lsearch -exact $steps $current_id] + 1]
+ set current_index [expr {[lsearch -exact $steps $current_id] + 1}]
if { [ns_queryexists wizard_submit_next] } {
@@ -566,7 +566,7 @@
} elseif { [ns_queryexists wizard_submit_back] } {
- set last_id [lindex $steps [expr $current_index - 2]]
+ set last_id [lindex $steps [expr {$current_index - 2}]]
template::forward [get_forward_url $last_id] $cache_p $persistent_p $excluded_vars
} elseif { [ns_queryexists wizard_submit_repeat] } {
@@ -578,7 +578,7 @@
# template::forward $properties(action)
# NOTE : we are changing the behaviour of wizard, when its finish it will not reset and go back
# to step 1, it will blindly go forward and we will catch this on get_current_step
- set next_id [expr $current_index + 1]
+ set next_id [expr {$current_index + 1}]
template::forward [get_forward_url $next_id] $cache_p $persistent_p $excluded_vars
}
}
@@ -615,7 +615,7 @@
if { [lsearch -exact [split [lindex [split $param ":"] 1] ","] "array"] != -1 || [array exists value] } {
# Array
foreach {index array_value} [array get value] {
- if { [info exists array_value] && ![empty_string_p $array_value] } {
+ if { [info exists array_value] && $array_value ne "" } {
append url "&$param.$index=[ns_urlencode $array_value]"
} else {
append url "&$param.$index="
@@ -684,7 +684,7 @@
# check the old visited step on the the state manager
set visited_step [ad_get_client_property -default "" $key ${wizard_name}visited]
- if {![string equal $visited_step ""]} {
+ if {$visited_step ne "" } {
template::wizard::set_visited_step $visited_step
}
@@ -710,7 +710,7 @@
get_reference
# save the state of the visited step for this wizard
- if { ![string equal $key ""] } {
+ if { $key ne "" } {
ad_set_client_property $key ${wizard_name}visited [template::wizard::get_visited_step]
}
Index: openacs-4/packages/acs-templating/tcl/test/spell-checker-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/test/spell-checker-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/acs-templating/tcl/test/spell-checker-procs.tcl 15 Feb 2004 11:16:29 -0000 1.6
+++ openacs-4/packages/acs-templating/tcl/test/spell-checker-procs.tcl 10 Jan 2007 21:22:13 -0000 1.7
@@ -29,11 +29,11 @@
eval $command
- aa_true "True statement: Text contains no misspelled words" [expr $error_num == 0]
+ aa_true "True statement: Text contains no misspelled words" [expr {$error_num == 0}]
aa_log "Number of miss-spelled words found in text: $error_num"
- aa_false "False statement: Text contains misspelled word(s)" [expr $error_num > 0]
+ aa_false "False statement: Text contains misspelled word(s)" [expr {$error_num > 0}]
aa_equals "Number of misspelled words found in text" $error_num 0
@@ -45,7 +45,7 @@
aa_true "The returned string contains no hidden var(s) named 'var_to_spellcheck.error_N', where N is the error number." \
![regexp "var_to_spellcheck.error_\[0-9\]*" $formtext_to_display]
- aa_true "just_the_errwords is empty" [empty_string_p $just_the_errwords]
+ aa_true "just_the_errwords is empty" [expr {$just_the_errwords eq ""}]
#####
#
@@ -61,18 +61,18 @@
eval $command
- aa_true "True statement: Text contains misspelled words" [expr $error_num > 0]
+ aa_true "True statement: Text contains misspelled words" [expr {$error_num > 0}]
aa_log "Number of misspelled words found in text: $error_num"
- aa_false "False statement: Text contains no misspelled word(s)" [expr $error_num == 0]
+ aa_false "False statement: Text contains no misspelled word(s)" [expr {$error_num == 0}]
aa_log "Returned string: $formtext_to_display"
aa_true "The returned string contains a hidden var named 'var_to_spellcheck.merge_text'" \
[regexp "var_to_spellcheck.merge_text" $formtext_to_display]
- aa_true "The returned string contains $error_num hidden var(s) named 'var_to_spellcheck.error_N', where N is a number between 0 and [expr $error_num - 1]." \
+ aa_true "The returned string contains $error_num hidden var(s) named 'var_to_spellcheck.error_N', where N is a number between 0 and [expr {$error_num - 1}]." \
[regexp "var_to_spellcheck.error_\[0-9\]*" $formtext_to_display]
aa_equals "The number of misspelled words matches the number of error placeholders in the merge_text" [regexp -all "var_to_spellcheck.error_\[0-9\]*" $formtext_to_display] [regexp -all "\#\[0-9\]*\#" $formtext_to_display]
@@ -93,11 +93,11 @@
eval $command
- aa_true "True statement: HTML fragment contains no misspelled words" [expr $error_num == 0]
+ aa_true "True statement: HTML fragment contains no misspelled words" [expr {$error_num == 0}]
aa_log "Number of miss-spelled words found in HTML fragment: $error_num"
- aa_false "False statement: HTML fragment contains misspelled word(s)" [expr $error_num > 0]
+ aa_false "False statement: HTML fragment contains misspelled word(s)" [expr {$error_num > 0}]
aa_equals "Number of misspelled words found in HTML fragment" $error_num 0
@@ -109,7 +109,7 @@
aa_true "The returned string contains no hidden var(s) named 'var_to_spellcheck.error_N', where N is the error number." \
![regexp "var_to_spellcheck.error_\[0-9\]*" $formtext_to_display]
- aa_true "just_the_errwords is empty" [empty_string_p $just_the_errwords]
+ aa_true "just_the_errwords is empty" [expr {$just_the_errwords eq ""}]
#####
#
@@ -126,11 +126,11 @@
eval $command
- aa_true "True statement: HTML fragment contains misspelled words" [expr $error_num > 0]
+ aa_true "True statement: HTML fragment contains misspelled words" [expr {$error_num > 0}]
aa_log "Number of miss-spelled words found in HTML fragment: $error_num"
- aa_false "False statement: HTML fragment contains no misspelled word(s)" [expr $error_num == 0]
+ aa_false "False statement: HTML fragment contains no misspelled word(s)" [expr {$error_num == 0}]
aa_log "Returned string: $formtext_to_display"
Index: openacs-4/packages/acs-templating/www/admin/test/chain-frac-0.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/www/admin/test/chain-frac-0.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-templating/www/admin/test/chain-frac-0.tcl 13 Mar 2001 22:59:27 -0000 1.1
+++ openacs-4/packages/acs-templating/www/admin/test/chain-frac-0.tcl 10 Jan 2007 21:22:13 -0000 1.2
@@ -10,48 +10,48 @@
<body>
<h2>Chain Fraction</h2>"
-set e [expr exp(1)]
+set e [expr {exp(1)}]
-set e0 [expr int ( $e ) ]; # keep the integer part in e0
-set xf [expr 1 / ($e - $e0) ]; # invert the fractional part
-set e1 [expr int ( $xf ) ]; # keep the integer part in e1
-set xf [expr 1 / ($xf - $e1) ]; # invert the fractional part
-set e2 [expr int ( $xf ) ]; # keep the integer part in e2
-set xf [expr 1 / ($xf - $e2) ]; # invert the fractional part
-set e3 [expr int ( $xf ) ]; # keep the integer part in e3
-set xf [expr 1 / ($xf - $e3) ]; # invert the fractional part
-set e4 [expr int ( $xf ) ]; # keep the integer part in e4
-set xf [expr 1 / ($xf - $e4) ]; # invert the fractional part
-set e5 [expr int ( $xf ) ]; # keep the integer part in e5
-set xf [expr 1 / ($xf - $e5) ]; # invert the fractional part
-set e6 [expr int ( $xf ) ]; # keep the integer part in e6
-set xf [expr 1 / ($xf - $e6) ]; # invert the fractional part
-set e7 [expr int ( $xf ) ]; # keep the integer part in e7
-set xf [expr 1 / ($xf - $e7) ]; # invert the fractional part
-set e8 [expr int ( $xf ) ]; # keep the integer part in e8
-set xf [expr 1 / ($xf - $e8) ]; # invert the fractional part
-set e9 [expr int ( $xf ) ]; # keep the integer part in e9
-set xf [expr 1 / ($xf - $e9) ]; # invert the fractional part
-set e10 [expr int ( $xf ) ]; # keep the integer part in e10
-set xf [expr 1 / ($xf - $e10) ]; # invert the fractional part
-set e11 [expr int ( $xf ) ]; # keep the integer part in e11
-set xf [expr 1 / ($xf - $e11) ]; # invert the fractional part
-set e12 [expr int ( $xf ) ]; # keep the integer part in e12
-set xf [expr 1 / ($xf - $e12) ]; # invert the fractional part
-set e13 [expr int ( $xf ) ]; # keep the integer part in e13
-set xf [expr 1 / ($xf - $e13) ]; # invert the fractional part
-set e14 [expr int ( $xf ) ]; # keep the integer part in e14
-set xf [expr 1 / ($xf - $e14) ]; # invert the fractional part
-set e15 [expr int ( $xf ) ]; # keep the integer part in e15
-set xf [expr 1 / ($xf - $e15) ]; # invert the fractional part
-set e16 [expr int ( $xf ) ]; # keep the integer part in e16
-set xf [expr 1 / ($xf - $e16) ]; # invert the fractional part
-set e17 [expr int ( $xf ) ]; # keep the integer part in e17
-set xf [expr 1 / ($xf - $e17) ]; # invert the fractional part
-set e18 [expr int ( $xf ) ]; # keep the integer part in e18
-set xf [expr 1 / ($xf - $e18) ]; # invert the fractional part
-set e19 [expr int ( $xf ) ]; # keep the integer part in e19
-set xf [expr 1 / ($xf - $e19) ]; # invert the fractional part
+set e0 [expr {int ( $e ) }]; # keep the integer part in e0
+set xf [expr {1 / ($e - $e0) }]; # invert the fractional part
+set e1 [expr {int ( $xf ) }]; # keep the integer part in e1
+set xf [expr {1 / ($xf - $e1) }]; # invert the fractional part
+set e2 [expr {int ( $xf ) }]; # keep the integer part in e2
+set xf [expr {1 / ($xf - $e2) }]; # invert the fractional part
+set e3 [expr {int ( $xf ) }]; # keep the integer part in e3
+set xf [expr {1 / ($xf - $e3) }]; # invert the fractional part
+set e4 [expr {int ( $xf ) }]; # keep the integer part in e4
+set xf [expr {1 / ($xf - $e4) }]; # invert the fractional part
+set e5 [expr {int ( $xf ) }]; # keep the integer part in e5
+set xf [expr {1 / ($xf - $e5) }]; # invert the fractional part
+set e6 [expr {int ( $xf ) }]; # keep the integer part in e6
+set xf [expr {1 / ($xf - $e6) }]; # invert the fractional part
+set e7 [expr {int ( $xf ) }]; # keep the integer part in e7
+set xf [expr {1 / ($xf - $e7) }]; # invert the fractional part
+set e8 [expr {int ( $xf ) }]; # keep the integer part in e8
+set xf [expr {1 / ($xf - $e8) }]; # invert the fractional part
+set e9 [expr {int ( $xf ) }]; # keep the integer part in e9
+set xf [expr {1 / ($xf - $e9) }]; # invert the fractional part
+set e10 [expr {int ( $xf ) }]; # keep the integer part in e10
+set xf [expr {1 / ($xf - $e10) }]; # invert the fractional part
+set e11 [expr {int ( $xf ) }]; # keep the integer part in e11
+set xf [expr {1 / ($xf - $e11) }]; # invert the fractional part
+set e12 [expr {int ( $xf ) }]; # keep the integer part in e12
+set xf [expr {1 / ($xf - $e12) }]; # invert the fractional part
+set e13 [expr {int ( $xf ) }]; # keep the integer part in e13
+set xf [expr {1 / ($xf - $e13) }]; # invert the fractional part
+set e14 [expr {int ( $xf ) }]; # keep the integer part in e14
+set xf [expr {1 / ($xf - $e14) }]; # invert the fractional part
+set e15 [expr {int ( $xf ) }]; # keep the integer part in e15
+set xf [expr {1 / ($xf - $e15) }]; # invert the fractional part
+set e16 [expr {int ( $xf ) }]; # keep the integer part in e16
+set xf [expr {1 / ($xf - $e16) }]; # invert the fractional part
+set e17 [expr {int ( $xf ) }]; # keep the integer part in e17
+set xf [expr {1 / ($xf - $e17) }]; # invert the fractional part
+set e18 [expr {int ( $xf ) }]; # keep the integer part in e18
+set xf [expr {1 / ($xf - $e18) }]; # invert the fractional part
+set e19 [expr {int ( $xf ) }]; # keep the integer part in e19
+set xf [expr {1 / ($xf - $e19) }]; # invert the fractional part
append page "
<h3>Natural <var>e</var></h3>
@@ -103,46 +103,46 @@
set g [expr (sqrt(5)+1)/2]
-set g0 [expr int ( $g ) ]; # keep the integer part in g0
-set xf [expr 1 / ($g - $g0) ]; # invert the fractional part
-set g1 [expr int ( $xf ) ]; # keep the integer part in g1
-set xf [expr 1 / ($xf - $g1) ]; # invert the fractional part
-set g2 [expr int ( $xf ) ]; # keep the integer part in g2
-set xf [expr 1 / ($xf - $g2) ]; # invert the fractional part
-set g3 [expr int ( $xf ) ]; # keep the integer part in g3
-set xf [expr 1 / ($xf - $g3) ]; # invert the fractional part
-set g4 [expr int ( $xf ) ]; # keep the integer part in g4
-set xf [expr 1 / ($xf - $g4) ]; # invert the fractional part
-set g5 [expr int ( $xf ) ]; # keep the integer part in g5
-set xf [expr 1 / ($xf - $g5) ]; # invert the fractional part
-set g6 [expr int ( $xf ) ]; # keep the integer part in g6
-set xf [expr 1 / ($xf - $g6) ]; # invert the fractional part
-set g7 [expr int ( $xf ) ]; # keep the integer part in g7
-set xf [expr 1 / ($xf - $g7) ]; # invert the fractional part
-set g8 [expr int ( $xf ) ]; # keep the integer part in g8
-set xf [expr 1 / ($xf - $g8) ]; # invert the fractional part
-set g9 [expr int ( $xf ) ]; # keep the integer part in g9
-set xf [expr 1 / ($xf - $g9) ]; # invert the fractional part
-set g10 [expr int ( $xf ) ]; # keep the integer part in g10
-set xf [expr 1 / ($xf - $g10) ]; # invert the fractional part
-set g11 [expr int ( $xf ) ]; # keep the integer part in g11
-set xf [expr 1 / ($xf - $g11) ]; # invert the fractional part
-set g12 [expr int ( $xf ) ]; # keep the integer part in g12
-set xf [expr 1 / ($xf - $g12) ]; # invert the fractional part
-set g13 [expr int ( $xf ) ]; # keep the integer part in g13
-set xf [expr 1 / ($xf - $g13) ]; # invert the fractional part
-set g14 [expr int ( $xf ) ]; # keep the integer part in g14
-set xf [expr 1 / ($xf - $g14) ]; # invert the fractional part
-set g15 [expr int ( $xf ) ]; # keep the integer part in g15
-set xf [expr 1 / ($xf - $g15) ]; # invert the fractional part
-set g16 [expr int ( $xf ) ]; # keep the integer part in g16
-set xf [expr 1 / ($xf - $g16) ]; # invert the fractional part
-set g17 [expr int ( $xf ) ]; # keep the integer part in g17
-set xf [expr 1 / ($xf - $g17) ]; # invert the fractional part
-set g18 [expr int ( $xf ) ]; # keep the integer part in g18
-set xf [expr 1 / ($xf - $g18) ]; # invert the fractional part
-set g19 [expr int ( $xf ) ]; # keep the integer part in g19
-set xf [expr 1 / ($xf - $g19) ]; # invert the fractional part
+set g0 [expr {int ( $g ) }]; # keep the integer part in g0
+set xf [expr {1 / ($g - $g0) }]; # invert the fractional part
+set g1 [expr {int ( $xf ) }]; # keep the integer part in g1
+set xf [expr {1 / ($xf - $g1) }]; # invert the fractional part
+set g2 [expr {int ( $xf ) }]; # keep the integer part in g2
+set xf [expr {1 / ($xf - $g2) }]; # invert the fractional part
+set g3 [expr {int ( $xf ) }]; # keep the integer part in g3
+set xf [expr {1 / ($xf - $g3) }]; # invert the fractional part
+set g4 [expr {int ( $xf ) }]; # keep the integer part in g4
+set xf [expr {1 / ($xf - $g4) }]; # invert the fractional part
+set g5 [expr {int ( $xf ) }]; # keep the integer part in g5
+set xf [expr {1 / ($xf - $g5) }]; # invert the fractional part
+set g6 [expr {int ( $xf ) }]; # keep the integer part in g6
+set xf [expr {1 / ($xf - $g6) }]; # invert the fractional part
+set g7 [expr {int ( $xf ) }]; # keep the integer part in g7
+set xf [expr {1 / ($xf - $g7) }]; # invert the fractional part
+set g8 [expr {int ( $xf ) }]; # keep the integer part in g8
+set xf [expr {1 / ($xf - $g8) }]; # invert the fractional part
+set g9 [expr {int ( $xf ) }]; # keep the integer part in g9
+set xf [expr {1 / ($xf - $g9) }]; # invert the fractional part
+set g10 [expr {int ( $xf ) }]; # keep the integer part in g10
+set xf [expr {1 / ($xf - $g10) }]; # invert the fractional part
+set g11 [expr {int ( $xf ) }]; # keep the integer part in g11
+set xf [expr {1 / ($xf - $g11) }]; # invert the fractional part
+set g12 [expr {int ( $xf ) }]; # keep the integer part in g12
+set xf [expr {1 / ($xf - $g12) }]; # invert the fractional part
+set g13 [expr {int ( $xf ) }]; # keep the integer part in g13
+set xf [expr {1 / ($xf - $g13) }]; # invert the fractional part
+set g14 [expr {int ( $xf ) }]; # keep the integer part in g14
+set xf [expr {1 / ($xf - $g14) }]; # invert the fractional part
+set g15 [expr {int ( $xf ) }]; # keep the integer part in g15
+set xf [expr {1 / ($xf - $g15) }]; # invert the fractional part
+set g16 [expr {int ( $xf ) }]; # keep the integer part in g16
+set xf [expr {1 / ($xf - $g16) }]; # invert the fractional part
+set g17 [expr {int ( $xf ) }]; # keep the integer part in g17
+set xf [expr {1 / ($xf - $g17) }]; # invert the fractional part
+set g18 [expr {int ( $xf ) }]; # keep the integer part in g18
+set xf [expr {1 / ($xf - $g18) }]; # invert the fractional part
+set g19 [expr {int ( $xf ) }]; # keep the integer part in g19
+set xf [expr {1 / ($xf - $g19) }]; # invert the fractional part
append page "
<h3>Golden Ratio</h3>
@@ -191,48 +191,48 @@
# Square root of 3
-set r [expr sqrt(3)]
+set r [expr {sqrt(3)}]
-set r0 [expr int ( $r ) ]; # keep the integer part in r0
-set xf [expr 1 / ($r - $r0) ]; # invert the fractional part
-set r1 [expr int ( $xf ) ]; # keep the integer part in r1
-set xf [expr 1 / ($xf - $r1) ]; # invert the fractional part
-set r2 [expr int ( $xf ) ]; # keep the integer part in r2
-set xf [expr 1 / ($xf - $r2) ]; # invert the fractional part
-set r3 [expr int ( $xf ) ]; # keep the integer part in r3
-set xf [expr 1 / ($xf - $r3) ]; # invert the fractional part
-set r4 [expr int ( $xf ) ]; # keep the integer part in r4
-set xf [expr 1 / ($xf - $r4) ]; # invert the fractional part
-set r5 [expr int ( $xf ) ]; # keep the integer part in r5
-set xf [expr 1 / ($xf - $r5) ]; # invert the fractional part
-set r6 [expr int ( $xf ) ]; # keep the integer part in r6
-set xf [expr 1 / ($xf - $r6) ]; # invert the fractional part
-set r7 [expr int ( $xf ) ]; # keep the integer part in r7
-set xf [expr 1 / ($xf - $r7) ]; # invert the fractional part
-set r8 [expr int ( $xf ) ]; # keep the integer part in r8
-set xf [expr 1 / ($xf - $r8) ]; # invert the fractional part
-set r9 [expr int ( $xf ) ]; # keep the integer part in r9
-set xf [expr 1 / ($xf - $r9) ]; # invert the fractional part
-set r10 [expr int ( $xf ) ]; # keep the integer part in r10
-set xf [expr 1 / ($xf - $r10) ]; # invert the fractional part
-set r11 [expr int ( $xf ) ]; # keep the integer part in r11
-set xf [expr 1 / ($xf - $r11) ]; # invert the fractional part
-set r12 [expr int ( $xf ) ]; # keep the integer part in r12
-set xf [expr 1 / ($xf - $r12) ]; # invert the fractional part
-set r13 [expr int ( $xf ) ]; # keep the integer part in r13
-set xf [expr 1 / ($xf - $r13) ]; # invert the fractional part
-set r14 [expr int ( $xf ) ]; # keep the integer part in r14
-set xf [expr 1 / ($xf - $r14) ]; # invert the fractional part
-set r15 [expr int ( $xf ) ]; # keep the integer part in r15
-set xf [expr 1 / ($xf - $r15) ]; # invert the fractional part
-set r16 [expr int ( $xf ) ]; # keep the integer part in r16
-set xf [expr 1 / ($xf - $r16) ]; # invert the fractional part
-set r17 [expr int ( $xf ) ]; # keep the integer part in r17
-set xf [expr 1 / ($xf - $r17) ]; # invert the fractional part
-set r18 [expr int ( $xf ) ]; # keep the integer part in r18
-set xf [expr 1 / ($xf - $r18) ]; # invert the fractional part
-set r19 [expr int ( $xf ) ]; # keep the integer part in r19
-set xf [expr 1 / ($xf - $r19) ]; # invert the fractional part
+set r0 [expr {int ( $r ) }]; # keep the integer part in r0
+set xf [expr {1 / ($r - $r0) }]; # invert the fractional part
+set r1 [expr {int ( $xf ) }]; # keep the integer part in r1
+set xf [expr {1 / ($xf - $r1) }]; # invert the fractional part
+set r2 [expr {int ( $xf ) }]; # keep the integer part in r2
+set xf [expr {1 / ($xf - $r2) }]; # invert the fractional part
+set r3 [expr {int ( $xf ) }]; # keep the integer part in r3
+set xf [expr {1 / ($xf - $r3) }]; # invert the fractional part
+set r4 [expr {int ( $xf ) }]; # keep the integer part in r4
+set xf [expr {1 / ($xf - $r4) }]; # invert the fractional part
+set r5 [expr {int ( $xf ) }]; # keep the integer part in r5
+set xf [expr {1 / ($xf - $r5) }]; # invert the fractional part
+set r6 [expr {int ( $xf ) }]; # keep the integer part in r6
+set xf [expr {1 / ($xf - $r6) }]; # invert the fractional part
+set r7 [expr {int ( $xf ) }]; # keep the integer part in r7
+set xf [expr {1 / ($xf - $r7) }]; # invert the fractional part
+set r8 [expr {int ( $xf ) }]; # keep the integer part in r8
+set xf [expr {1 / ($xf - $r8) }]; # invert the fractional part
+set r9 [expr {int ( $xf ) }]; # keep the integer part in r9
+set xf [expr {1 / ($xf - $r9) }]; # invert the fractional part
+set r10 [expr {int ( $xf ) }]; # keep the integer part in r10
+set xf [expr {1 / ($xf - $r10) }]; # invert the fractional part
+set r11 [expr {int ( $xf ) }]; # keep the integer part in r11
+set xf [expr {1 / ($xf - $r11) }]; # invert the fractional part
+set r12 [expr {int ( $xf ) }]; # keep the integer part in r12
+set xf [expr {1 / ($xf - $r12) }]; # invert the fractional part
+set r13 [expr {int ( $xf ) }]; # keep the integer part in r13
+set xf [expr {1 / ($xf - $r13) }]; # invert the fractional part
+set r14 [expr {int ( $xf ) }]; # keep the integer part in r14
+set xf [expr {1 / ($xf - $r14) }]; # invert the fractional part
+set r15 [expr {int ( $xf ) }]; # keep the integer part in r15
+set xf [expr {1 / ($xf - $r15) }]; # invert the fractional part
+set r16 [expr {int ( $xf ) }]; # keep the integer part in r16
+set xf [expr {1 / ($xf - $r16) }]; # invert the fractional part
+set r17 [expr {int ( $xf ) }]; # keep the integer part in r17
+set xf [expr {1 / ($xf - $r17) }]; # invert the fractional part
+set r18 [expr {int ( $xf ) }]; # keep the integer part in r18
+set xf [expr {1 / ($xf - $r18) }]; # invert the fractional part
+set r19 [expr {int ( $xf ) }]; # keep the integer part in r19
+set xf [expr {1 / ($xf - $r19) }]; # invert the fractional part
append page "
<h3>Square root of 3</h3>
@@ -281,46 +281,46 @@
# the user's x
-set n0 [expr int ( $x ) ]; # keep the integer part in n0
-set xf [expr 1 / ($x - $n0) ]; # invert the fractional part
-set n1 [expr int ( $xf ) ]; # keep the integer part in n1
-set xf [expr 1 / ($xf - $n1) ]; # invert the fractional part
-set n2 [expr int ( $xf ) ]; # keep the integer part in n2
-set xf [expr 1 / ($xf - $n2) ]; # invert the fractional part
-set n3 [expr int ( $xf ) ]; # keep the integer part in n3
-set xf [expr 1 / ($xf - $n3) ]; # invert the fractional part
-set n4 [expr int ( $xf ) ]; # keep the integer part in n4
-set xf [expr 1 / ($xf - $n4) ]; # invert the fractional part
-set n5 [expr int ( $xf ) ]; # keep the integer part in n5
-set xf [expr 1 / ($xf - $n5) ]; # invert the fractional part
-set n6 [expr int ( $xf ) ]; # keep the integer part in n6
-set xf [expr 1 / ($xf - $n6) ]; # invert the fractional part
-set n7 [expr int ( $xf ) ]; # keep the integer part in n7
-set xf [expr 1 / ($xf - $n7) ]; # invert the fractional part
-set n8 [expr int ( $xf ) ]; # keep the integer part in n8
-set xf [expr 1 / ($xf - $n8) ]; # invert the fractional part
-set n9 [expr int ( $xf ) ]; # keep the integer part in n9
-set xf [expr 1 / ($xf - $n9) ]; # invert the fractional part
-set n10 [expr int ( $xf ) ]; # keep the integer part in n10
-set xf [expr 1 / ($xf - $n10) ]; # invert the fractional part
-set n11 [expr int ( $xf ) ]; # keep the integer part in n11
-set xf [expr 1 / ($xf - $n11) ]; # invert the fractional part
-set n12 [expr int ( $xf ) ]; # keep the integer part in n12
-set xf [expr 1 / ($xf - $n12) ]; # invert the fractional part
-set n13 [expr int ( $xf ) ]; # keep the integer part in n13
-set xf [expr 1 / ($xf - $n13) ]; # invert the fractional part
-set n14 [expr int ( $xf ) ]; # keep the integer part in n14
-set xf [expr 1 / ($xf - $n14) ]; # invert the fractional part
-set n15 [expr int ( $xf ) ]; # keep the integer part in n15
-set xf [expr 1 / ($xf - $n15) ]; # invert the fractional part
-set n16 [expr int ( $xf ) ]; # keep the integer part in n16
-set xf [expr 1 / ($xf - $n16) ]; # invert the fractional part
-set n17 [expr int ( $xf ) ]; # keep the integer part in n17
-set xf [expr 1 / ($xf - $n17) ]; # invert the fractional part
-set n18 [expr int ( $xf ) ]; # keep the integer part in n18
-set xf [expr 1 / ($xf - $n18) ]; # invert the fractional part
-set n19 [expr int ( $xf ) ]; # keep the integer part in n19
-set xf [expr 1 / ($xf - $n19) ]; # invert the fractional part
+set n0 [expr {int ( $x ) }]; # keep the integer part in n0
+set xf [expr {1 / ($x - $n0) }]; # invert the fractional part
+set n1 [expr {int ( $xf ) }]; # keep the integer part in n1
+set xf [expr {1 / ($xf - $n1) }]; # invert the fractional part
+set n2 [expr {int ( $xf ) }]; # keep the integer part in n2
+set xf [expr {1 / ($xf - $n2) }]; # invert the fractional part
+set n3 [expr {int ( $xf ) }]; # keep the integer part in n3
+set xf [expr {1 / ($xf - $n3) }]; # invert the fractional part
+set n4 [expr {int ( $xf ) }]; # keep the integer part in n4
+set xf [expr {1 / ($xf - $n4) }]; # invert the fractional part
+set n5 [expr {int ( $xf ) }]; # keep the integer part in n5
+set xf [expr {1 / ($xf - $n5) }]; # invert the fractional part
+set n6 [expr {int ( $xf ) }]; # keep the integer part in n6
+set xf [expr {1 / ($xf - $n6) }]; # invert the fractional part
+set n7 [expr {int ( $xf ) }]; # keep the integer part in n7
+set xf [expr {1 / ($xf - $n7) }]; # invert the fractional part
+set n8 [expr {int ( $xf ) }]; # keep the integer part in n8
+set xf [expr {1 / ($xf - $n8) }]; # invert the fractional part
+set n9 [expr {int ( $xf ) }]; # keep the integer part in n9
+set xf [expr {1 / ($xf - $n9) }]; # invert the fractional part
+set n10 [expr {int ( $xf ) }]; # keep the integer part in n10
+set xf [expr {1 / ($xf - $n10) }]; # invert the fractional part
+set n11 [expr {int ( $xf ) }]; # keep the integer part in n11
+set xf [expr {1 / ($xf - $n11) }]; # invert the fractional part
+set n12 [expr {int ( $xf ) }]; # keep the integer part in n12
+set xf [expr {1 / ($xf - $n12) }]; # invert the fractional part
+set n13 [expr {int ( $xf ) }]; # keep the integer part in n13
+set xf [expr {1 / ($xf - $n13) }]; # invert the fractional part
+set n14 [expr {int ( $xf ) }]; # keep the integer part in n14
+set xf [expr {1 / ($xf - $n14) }]; # invert the fractional part
+set n15 [expr {int ( $xf ) }]; # keep the integer part in n15
+set xf [expr {1 / ($xf - $n15) }]; # invert the fractional part
+set n16 [expr {int ( $xf ) }]; # keep the integer part in n16
+set xf [expr {1 / ($xf - $n16) }]; # invert the fractional part
+set n17 [expr {int ( $xf ) }]; # keep the integer part in n17
+set xf [expr {1 / ($xf - $n17) }]; # invert the fractional part
+set n18 [expr {int ( $xf ) }]; # keep the integer part in n18
+set xf [expr {1 / ($xf - $n18) }]; # invert the fractional part
+set n19 [expr {int ( $xf ) }]; # keep the integer part in n19
+set xf [expr {1 / ($xf - $n19) }]; # invert the fractional part
append page "
<h3>Your <var>x</var></h3>
Index: openacs-4/packages/acs-templating/www/admin/test/chain-frac-1.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/www/admin/test/chain-frac-1.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-templating/www/admin/test/chain-frac-1.tcl 13 Mar 2001 22:59:27 -0000 1.1
+++ openacs-4/packages/acs-templating/www/admin/test/chain-frac-1.tcl 10 Jan 2007 21:22:13 -0000 1.2
@@ -95,180 +95,180 @@
# the user's x
-set n0 [expr int ( $x ) ]; # keep the integer part in n0
-set xf [expr 1 / ($x - $n0) ]; # invert the fractional part
-set n1 [expr int ( $xf ) ]; # keep the integer part in n1
-set xf [expr 1 / ($xf - $n1) ]; # invert the fractional part
-set n2 [expr int ( $xf ) ]; # keep the integer part in n2
-set xf [expr 1 / ($xf - $n2) ]; # invert the fractional part
-set n3 [expr int ( $xf ) ]; # keep the integer part in n3
-set xf [expr 1 / ($xf - $n3) ]; # invert the fractional part
-set n4 [expr int ( $xf ) ]; # keep the integer part in n4
-set xf [expr 1 / ($xf - $n4) ]; # invert the fractional part
-set n5 [expr int ( $xf ) ]; # keep the integer part in n5
-set xf [expr 1 / ($xf - $n5) ]; # invert the fractional part
-set n6 [expr int ( $xf ) ]; # keep the integer part in n6
-set xf [expr 1 / ($xf - $n6) ]; # invert the fractional part
-set n7 [expr int ( $xf ) ]; # keep the integer part in n7
-set xf [expr 1 / ($xf - $n7) ]; # invert the fractional part
-set n8 [expr int ( $xf ) ]; # keep the integer part in n8
-set xf [expr 1 / ($xf - $n8) ]; # invert the fractional part
-set n9 [expr int ( $xf ) ]; # keep the integer part in n9
-set xf [expr 1 / ($xf - $n9) ]; # invert the fractional part
-set n10 [expr int ( $xf ) ]; # keep the integer part in n10
-set xf [expr 1 / ($xf - $n10) ]; # invert the fractional part
-set n11 [expr int ( $xf ) ]; # keep the integer part in n11
-set xf [expr 1 / ($xf - $n11) ]; # invert the fractional part
-set n12 [expr int ( $xf ) ]; # keep the integer part in n12
-set xf [expr 1 / ($xf - $n12) ]; # invert the fractional part
-set n13 [expr int ( $xf ) ]; # keep the integer part in n13
-set xf [expr 1 / ($xf - $n13) ]; # invert the fractional part
-set n14 [expr int ( $xf ) ]; # keep the integer part in n14
-set xf [expr 1 / ($xf - $n14) ]; # invert the fractional part
-set n15 [expr int ( $xf ) ]; # keep the integer part in n15
-set xf [expr 1 / ($xf - $n15) ]; # invert the fractional part
-set n16 [expr int ( $xf ) ]; # keep the integer part in n16
-set xf [expr 1 / ($xf - $n16) ]; # invert the fractional part
-set n17 [expr int ( $xf ) ]; # keep the integer part in n17
-set xf [expr 1 / ($xf - $n17) ]; # invert the fractional part
-set n18 [expr int ( $xf ) ]; # keep the integer part in n18
-set xf [expr 1 / ($xf - $n18) ]; # invert the fractional part
-set n19 [expr int ( $xf ) ]; # keep the integer part in n19
-set xf [expr 1 / ($xf - $n19) ]; # invert the fractional part
+set n0 [expr {int ( $x ) }]; # keep the integer part in n0
+set xf [expr {1 / ($x - $n0) }]; # invert the fractional part
+set n1 [expr {int ( $xf ) }]; # keep the integer part in n1
+set xf [expr {1 / ($xf - $n1) }]; # invert the fractional part
+set n2 [expr {int ( $xf ) }]; # keep the integer part in n2
+set xf [expr {1 / ($xf - $n2) }]; # invert the fractional part
+set n3 [expr {int ( $xf ) }]; # keep the integer part in n3
+set xf [expr {1 / ($xf - $n3) }]; # invert the fractional part
+set n4 [expr {int ( $xf ) }]; # keep the integer part in n4
+set xf [expr {1 / ($xf - $n4) }]; # invert the fractional part
+set n5 [expr {int ( $xf ) }]; # keep the integer part in n5
+set xf [expr {1 / ($xf - $n5) }]; # invert the fractional part
+set n6 [expr {int ( $xf ) }]; # keep the integer part in n6
+set xf [expr {1 / ($xf - $n6) }]; # invert the fractional part
+set n7 [expr {int ( $xf ) }]; # keep the integer part in n7
+set xf [expr {1 / ($xf - $n7) }]; # invert the fractional part
+set n8 [expr {int ( $xf ) }]; # keep the integer part in n8
+set xf [expr {1 / ($xf - $n8) }]; # invert the fractional part
+set n9 [expr {int ( $xf ) }]; # keep the integer part in n9
+set xf [expr {1 / ($xf - $n9) }]; # invert the fractional part
+set n10 [expr {int ( $xf ) }]; # keep the integer part in n10
+set xf [expr {1 / ($xf - $n10) }]; # invert the fractional part
+set n11 [expr {int ( $xf ) }]; # keep the integer part in n11
+set xf [expr {1 / ($xf - $n11) }]; # invert the fractional part
+set n12 [expr {int ( $xf ) }]; # keep the integer part in n12
+set xf [expr {1 / ($xf - $n12) }]; # invert the fractional part
+set n13 [expr {int ( $xf ) }]; # keep the integer part in n13
+set xf [expr {1 / ($xf - $n13) }]; # invert the fractional part
+set n14 [expr {int ( $xf ) }]; # keep the integer part in n14
+set xf [expr {1 / ($xf - $n14) }]; # invert the fractional part
+set n15 [expr {int ( $xf ) }]; # keep the integer part in n15
+set xf [expr {1 / ($xf - $n15) }]; # invert the fractional part
+set n16 [expr {int ( $xf ) }]; # keep the integer part in n16
+set xf [expr {1 / ($xf - $n16) }]; # invert the fractional part
+set n17 [expr {int ( $xf ) }]; # keep the integer part in n17
+set xf [expr {1 / ($xf - $n17) }]; # invert the fractional part
+set n18 [expr {int ( $xf ) }]; # keep the integer part in n18
+set xf [expr {1 / ($xf - $n18) }]; # invert the fractional part
+set n19 [expr {int ( $xf ) }]; # keep the integer part in n19
+set xf [expr {1 / ($xf - $n19) }]; # invert the fractional part
# e
-set e [expr exp(1)]
+set e [expr {exp(1)}]
-set e0 [expr int ( $e ) ]; # keep the integer part in e0
-set xf [expr 1 / ($e - $e0) ]; # invert the fractional part
-set e1 [expr int ( $xf ) ]; # keep the integer part in e1
-set xf [expr 1 / ($xf - $e1) ]; # invert the fractional part
-set e2 [expr int ( $xf ) ]; # keep the integer part in e2
-set xf [expr 1 / ($xf - $e2) ]; # invert the fractional part
-set e3 [expr int ( $xf ) ]; # keep the integer part in e3
-set xf [expr 1 / ($xf - $e3) ]; # invert the fractional part
-set e4 [expr int ( $xf ) ]; # keep the integer part in e4
-set xf [expr 1 / ($xf - $e4) ]; # invert the fractional part
-set e5 [expr int ( $xf ) ]; # keep the integer part in e5
-set xf [expr 1 / ($xf - $e5) ]; # invert the fractional part
-set e6 [expr int ( $xf ) ]; # keep the integer part in e6
-set xf [expr 1 / ($xf - $e6) ]; # invert the fractional part
-set e7 [expr int ( $xf ) ]; # keep the integer part in e7
-set xf [expr 1 / ($xf - $e7) ]; # invert the fractional part
-set e8 [expr int ( $xf ) ]; # keep the integer part in e8
-set xf [expr 1 / ($xf - $e8) ]; # invert the fractional part
-set e9 [expr int ( $xf ) ]; # keep the integer part in e9
-set xf [expr 1 / ($xf - $e9) ]; # invert the fractional part
-set e10 [expr int ( $xf ) ]; # keep the integer part in e10
-set xf [expr 1 / ($xf - $e10) ]; # invert the fractional part
-set e11 [expr int ( $xf ) ]; # keep the integer part in e11
-set xf [expr 1 / ($xf - $e11) ]; # invert the fractional part
-set e12 [expr int ( $xf ) ]; # keep the integer part in e12
-set xf [expr 1 / ($xf - $e12) ]; # invert the fractional part
-set e13 [expr int ( $xf ) ]; # keep the integer part in e13
-set xf [expr 1 / ($xf - $e13) ]; # invert the fractional part
-set e14 [expr int ( $xf ) ]; # keep the integer part in e14
-set xf [expr 1 / ($xf - $e14) ]; # invert the fractional part
-set e15 [expr int ( $xf ) ]; # keep the integer part in e15
-set xf [expr 1 / ($xf - $e15) ]; # invert the fractional part
-set e16 [expr int ( $xf ) ]; # keep the integer part in e16
-set xf [expr 1 / ($xf - $e16) ]; # invert the fractional part
-set e17 [expr int ( $xf ) ]; # keep the integer part in e17
-set xf [expr 1 / ($xf - $e17) ]; # invert the fractional part
-set e18 [expr int ( $xf ) ]; # keep the integer part in e18
-set xf [expr 1 / ($xf - $e18) ]; # invert the fractional part
-set e19 [expr int ( $xf ) ]; # keep the integer part in e19
-set xf [expr 1 / ($xf - $e19) ]; # invert the fractional part
+set e0 [expr {int ( $e ) }]; # keep the integer part in e0
+set xf [expr {1 / ($e - $e0) }]; # invert the fractional part
+set e1 [expr {int ( $xf ) }]; # keep the integer part in e1
+set xf [expr {1 / ($xf - $e1) }]; # invert the fractional part
+set e2 [expr {int ( $xf ) }]; # keep the integer part in e2
+set xf [expr {1 / ($xf - $e2) }]; # invert the fractional part
+set e3 [expr {int ( $xf ) }]; # keep the integer part in e3
+set xf [expr {1 / ($xf - $e3) }]; # invert the fractional part
+set e4 [expr {int ( $xf ) }]; # keep the integer part in e4
+set xf [expr {1 / ($xf - $e4) }]; # invert the fractional part
+set e5 [expr {int ( $xf ) }]; # keep the integer part in e5
+set xf [expr {1 / ($xf - $e5) }]; # invert the fractional part
+set e6 [expr {int ( $xf ) }]; # keep the integer part in e6
+set xf [expr {1 / ($xf - $e6) }]; # invert the fractional part
+set e7 [expr {int ( $xf ) }]; # keep the integer part in e7
+set xf [expr {1 / ($xf - $e7) }]; # invert the fractional part
+set e8 [expr {int ( $xf ) }]; # keep the integer part in e8
+set xf [expr {1 / ($xf - $e8) }]; # invert the fractional part
+set e9 [expr {int ( $xf ) }]; # keep the integer part in e9
+set xf [expr {1 / ($xf - $e9) }]; # invert the fractional part
+set e10 [expr {int ( $xf ) }]; # keep the integer part in e10
+set xf [expr {1 / ($xf - $e10) }]; # invert the fractional part
+set e11 [expr {int ( $xf ) }]; # keep the integer part in e11
+set xf [expr {1 / ($xf - $e11) }]; # invert the fractional part
+set e12 [expr {int ( $xf ) }]; # keep the integer part in e12
+set xf [expr {1 / ($xf - $e12) }]; # invert the fractional part
+set e13 [expr {int ( $xf ) }]; # keep the integer part in e13
+set xf [expr {1 / ($xf - $e13) }]; # invert the fractional part
+set e14 [expr {int ( $xf ) }]; # keep the integer part in e14
+set xf [expr {1 / ($xf - $e14) }]; # invert the fractional part
+set e15 [expr {int ( $xf ) }]; # keep the integer part in e15
+set xf [expr {1 / ($xf - $e15) }]; # invert the fractional part
+set e16 [expr {int ( $xf ) }]; # keep the integer part in e16
+set xf [expr {1 / ($xf - $e16) }]; # invert the fractional part
+set e17 [expr {int ( $xf ) }]; # keep the integer part in e17
+set xf [expr {1 / ($xf - $e17) }]; # invert the fractional part
+set e18 [expr {int ( $xf ) }]; # keep the integer part in e18
+set xf [expr {1 / ($xf - $e18) }]; # invert the fractional part
+set e19 [expr {int ( $xf ) }]; # keep the integer part in e19
+set xf [expr {1 / ($xf - $e19) }]; # invert the fractional part
# golden ratio
set g [expr (sqrt(5)+1)/2]
-set g0 [expr int ( $g ) ]; # keep the integer part in g0
-set xf [expr 1 / ($g - $g0) ]; # invert the fractional part
-set g1 [expr int ( $xf ) ]; # keep the integer part in g1
-set xf [expr 1 / ($xf - $g1) ]; # invert the fractional part
-set g2 [expr int ( $xf ) ]; # keep the integer part in g2
-set xf [expr 1 / ($xf - $g2) ]; # invert the fractional part
-set g3 [expr int ( $xf ) ]; # keep the integer part in g3
-set xf [expr 1 / ($xf - $g3) ]; # invert the fractional part
-set g4 [expr int ( $xf ) ]; # keep the integer part in g4
-set xf [expr 1 / ($xf - $g4) ]; # invert the fractional part
-set g5 [expr int ( $xf ) ]; # keep the integer part in g5
-set xf [expr 1 / ($xf - $g5) ]; # invert the fractional part
-set g6 [expr int ( $xf ) ]; # keep the integer part in g6
-set xf [expr 1 / ($xf - $g6) ]; # invert the fractional part
-set g7 [expr int ( $xf ) ]; # keep the integer part in g7
-set xf [expr 1 / ($xf - $g7) ]; # invert the fractional part
-set g8 [expr int ( $xf ) ]; # keep the integer part in g8
-set xf [expr 1 / ($xf - $g8) ]; # invert the fractional part
-set g9 [expr int ( $xf ) ]; # keep the integer part in g9
-set xf [expr 1 / ($xf - $g9) ]; # invert the fractional part
-set g10 [expr int ( $xf ) ]; # keep the integer part in g10
-set xf [expr 1 / ($xf - $g10) ]; # invert the fractional part
-set g11 [expr int ( $xf ) ]; # keep the integer part in g11
-set xf [expr 1 / ($xf - $g11) ]; # invert the fractional part
-set g12 [expr int ( $xf ) ]; # keep the integer part in g12
-set xf [expr 1 / ($xf - $g12) ]; # invert the fractional part
-set g13 [expr int ( $xf ) ]; # keep the integer part in g13
-set xf [expr 1 / ($xf - $g13) ]; # invert the fractional part
-set g14 [expr int ( $xf ) ]; # keep the integer part in g14
-set xf [expr 1 / ($xf - $g14) ]; # invert the fractional part
-set g15 [expr int ( $xf ) ]; # keep the integer part in g15
-set xf [expr 1 / ($xf - $g15) ]; # invert the fractional part
-set g16 [expr int ( $xf ) ]; # keep the integer part in g16
-set xf [expr 1 / ($xf - $g16) ]; # invert the fractional part
-set g17 [expr int ( $xf ) ]; # keep the integer part in g17
-set xf [expr 1 / ($xf - $g17) ]; # invert the fractional part
-set g18 [expr int ( $xf ) ]; # keep the integer part in g18
-set xf [expr 1 / ($xf - $g18) ]; # invert the fractional part
-set g19 [expr int ( $xf ) ]; # keep the integer part in g19
-set xf [expr 1 / ($xf - $g19) ]; # invert the fractional part
+set g0 [expr {int ( $g ) }]; # keep the integer part in g0
+set xf [expr {1 / ($g - $g0) }]; # invert the fractional part
+set g1 [expr {int ( $xf ) }]; # keep the integer part in g1
+set xf [expr {1 / ($xf - $g1) }]; # invert the fractional part
+set g2 [expr {int ( $xf ) }]; # keep the integer part in g2
+set xf [expr {1 / ($xf - $g2) }]; # invert the fractional part
+set g3 [expr {int ( $xf ) }]; # keep the integer part in g3
+set xf [expr {1 / ($xf - $g3) }]; # invert the fractional part
+set g4 [expr {int ( $xf ) }]; # keep the integer part in g4
+set xf [expr {1 / ($xf - $g4) }]; # invert the fractional part
+set g5 [expr {int ( $xf ) }]; # keep the integer part in g5
+set xf [expr {1 / ($xf - $g5) }]; # invert the fractional part
+set g6 [expr {int ( $xf ) }]; # keep the integer part in g6
+set xf [expr {1 / ($xf - $g6) }]; # invert the fractional part
+set g7 [expr {int ( $xf ) }]; # keep the integer part in g7
+set xf [expr {1 / ($xf - $g7) }]; # invert the fractional part
+set g8 [expr {int ( $xf ) }]; # keep the integer part in g8
+set xf [expr {1 / ($xf - $g8) }]; # invert the fractional part
+set g9 [expr {int ( $xf ) }]; # keep the integer part in g9
+set xf [expr {1 / ($xf - $g9) }]; # invert the fractional part
+set g10 [expr {int ( $xf ) }]; # keep the integer part in g10
+set xf [expr {1 / ($xf - $g10) }]; # invert the fractional part
+set g11 [expr {int ( $xf ) }]; # keep the integer part in g11
+set xf [expr {1 / ($xf - $g11) }]; # invert the fractional part
+set g12 [expr {int ( $xf ) }]; # keep the integer part in g12
+set xf [expr {1 / ($xf - $g12) }]; # invert the fractional part
+set g13 [expr {int ( $xf ) }]; # keep the integer part in g13
+set xf [expr {1 / ($xf - $g13) }]; # invert the fractional part
+set g14 [expr {int ( $xf ) }]; # keep the integer part in g14
+set xf [expr {1 / ($xf - $g14) }]; # invert the fractional part
+set g15 [expr {int ( $xf ) }]; # keep the integer part in g15
+set xf [expr {1 / ($xf - $g15) }]; # invert the fractional part
+set g16 [expr {int ( $xf ) }]; # keep the integer part in g16
+set xf [expr {1 / ($xf - $g16) }]; # invert the fractional part
+set g17 [expr {int ( $xf ) }]; # keep the integer part in g17
+set xf [expr {1 / ($xf - $g17) }]; # invert the fractional part
+set g18 [expr {int ( $xf ) }]; # keep the integer part in g18
+set xf [expr {1 / ($xf - $g18) }]; # invert the fractional part
+set g19 [expr {int ( $xf ) }]; # keep the integer part in g19
+set xf [expr {1 / ($xf - $g19) }]; # invert the fractional part
# Square root of 3
-set r [expr sqrt(3)]
+set r [expr {sqrt(3)}]
-set r0 [expr int ( $r ) ]; # keep the integer part in r0
-set xf [expr 1 / ($r - $r0) ]; # invert the fractional part
-set r1 [expr int ( $xf ) ]; # keep the integer part in r1
-set xf [expr 1 / ($xf - $r1) ]; # invert the fractional part
-set r2 [expr int ( $xf ) ]; # keep the integer part in r2
-set xf [expr 1 / ($xf - $r2) ]; # invert the fractional part
-set r3 [expr int ( $xf ) ]; # keep the integer part in r3
-set xf [expr 1 / ($xf - $r3) ]; # invert the fractional part
-set r4 [expr int ( $xf ) ]; # keep the integer part in r4
-set xf [expr 1 / ($xf - $r4) ]; # invert the fractional part
-set r5 [expr int ( $xf ) ]; # keep the integer part in r5
-set xf [expr 1 / ($xf - $r5) ]; # invert the fractional part
-set r6 [expr int ( $xf ) ]; # keep the integer part in r6
-set xf [expr 1 / ($xf - $r6) ]; # invert the fractional part
-set r7 [expr int ( $xf ) ]; # keep the integer part in r7
-set xf [expr 1 / ($xf - $r7) ]; # invert the fractional part
-set r8 [expr int ( $xf ) ]; # keep the integer part in r8
-set xf [expr 1 / ($xf - $r8) ]; # invert the fractional part
-set r9 [expr int ( $xf ) ]; # keep the integer part in r9
-set xf [expr 1 / ($xf - $r9) ]; # invert the fractional part
-set r10 [expr int ( $xf ) ]; # keep the integer part in r10
-set xf [expr 1 / ($xf - $r10) ]; # invert the fractional part
-set r11 [expr int ( $xf ) ]; # keep the integer part in r11
-set xf [expr 1 / ($xf - $r11) ]; # invert the fractional part
-set r12 [expr int ( $xf ) ]; # keep the integer part in r12
-set xf [expr 1 / ($xf - $r12) ]; # invert the fractional part
-set r13 [expr int ( $xf ) ]; # keep the integer part in r13
-set xf [expr 1 / ($xf - $r13) ]; # invert the fractional part
-set r14 [expr int ( $xf ) ]; # keep the integer part in r14
-set xf [expr 1 / ($xf - $r14) ]; # invert the fractional part
-set r15 [expr int ( $xf ) ]; # keep the integer part in r15
-set xf [expr 1 / ($xf - $r15) ]; # invert the fractional part
-set r16 [expr int ( $xf ) ]; # keep the integer part in r16
-set xf [expr 1 / ($xf - $r16) ]; # invert the fractional part
-set r17 [expr int ( $xf ) ]; # keep the integer part in r17
-set xf [expr 1 / ($xf - $r17) ]; # invert the fractional part
-set r18 [expr int ( $xf ) ]; # keep the integer part in r18
-set xf [expr 1 / ($xf - $r18) ]; # invert the fractional part
-set r19 [expr int ( $xf ) ]; # keep the integer part in r19
-set xf [expr 1 / ($xf - $r19) ]; # invert the fractional part
+set r0 [expr {int ( $r ) }]; # keep the integer part in r0
+set xf [expr {1 / ($r - $r0) }]; # invert the fractional part
+set r1 [expr {int ( $xf ) }]; # keep the integer part in r1
+set xf [expr {1 / ($xf - $r1) }]; # invert the fractional part
+set r2 [expr {int ( $xf ) }]; # keep the integer part in r2
+set xf [expr {1 / ($xf - $r2) }]; # invert the fractional part
+set r3 [expr {int ( $xf ) }]; # keep the integer part in r3
+set xf [expr {1 / ($xf - $r3) }]; # invert the fractional part
+set r4 [expr {int ( $xf ) }]; # keep the integer part in r4
+set xf [expr {1 / ($xf - $r4) }]; # invert the fractional part
+set r5 [expr {int ( $xf ) }]; # keep the integer part in r5
+set xf [expr {1 / ($xf - $r5) }]; # invert the fractional part
+set r6 [expr {int ( $xf ) }]; # keep the integer part in r6
+set xf [expr {1 / ($xf - $r6) }]; # invert the fractional part
+set r7 [expr {int ( $xf ) }]; # keep the integer part in r7
+set xf [expr {1 / ($xf - $r7) }]; # invert the fractional part
+set r8 [expr {int ( $xf ) }]; # keep the integer part in r8
+set xf [expr {1 / ($xf - $r8) }]; # invert the fractional part
+set r9 [expr {int ( $xf ) }]; # keep the integer part in r9
+set xf [expr {1 / ($xf - $r9) }]; # invert the fractional part
+set r10 [expr {int ( $xf ) }]; # keep the integer part in r10
+set xf [expr {1 / ($xf - $r10) }]; # invert the fractional part
+set r11 [expr {int ( $xf ) }]; # keep the integer part in r11
+set xf [expr {1 / ($xf - $r11) }]; # invert the fractional part
+set r12 [expr {int ( $xf ) }]; # keep the integer part in r12
+set xf [expr {1 / ($xf - $r12) }]; # invert the fractional part
+set r13 [expr {int ( $xf ) }]; # keep the integer part in r13
+set xf [expr {1 / ($xf - $r13) }]; # invert the fractional part
+set r14 [expr {int ( $xf ) }]; # keep the integer part in r14
+set xf [expr {1 / ($xf - $r14) }]; # invert the fractional part
+set r15 [expr {int ( $xf ) }]; # keep the integer part in r15
+set xf [expr {1 / ($xf - $r15) }]; # invert the fractional part
+set r16 [expr {int ( $xf ) }]; # keep the integer part in r16
+set xf [expr {1 / ($xf - $r16) }]; # invert the fractional part
+set r17 [expr {int ( $xf ) }]; # keep the integer part in r17
+set xf [expr {1 / ($xf - $r17) }]; # invert the fractional part
+set r18 [expr {int ( $xf ) }]; # keep the integer part in r18
+set xf [expr {1 / ($xf - $r18) }]; # invert the fractional part
+set r19 [expr {int ( $xf ) }]; # keep the integer part in r19
+set xf [expr {1 / ($xf - $r19) }]; # invert the fractional part
Index: openacs-4/packages/acs-templating/www/admin/test/include.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/www/admin/test/include.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-templating/www/admin/test/include.tcl 31 Jan 2005 21:03:19 -0000 1.2
+++ openacs-4/packages/acs-templating/www/admin/test/include.tcl 10 Jan 2007 21:22:13 -0000 1.3
@@ -1,4 +1,4 @@
-if [llength $l] {
+if {[llength $l]} {
set car [lindex $l 0]
set cdr [lrange $l 1 end]
Index: openacs-4/packages/acs-templating/www/doc/demo/contract-2.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/www/doc/demo/contract-2.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-templating/www/doc/demo/contract-2.tcl 10 Sep 2002 22:22:16 -0000 1.2
+++ openacs-4/packages/acs-templating/www/doc/demo/contract-2.tcl 10 Jan 2007 21:22:13 -0000 1.3
@@ -16,7 +16,7 @@
phrase:onevalue
} -return_errors error_list
-if [info exists error_list] {
+if {[info exists error_list]} {
# divert to error-handling page
ad_return_template "contract-err"
} else {
@@ -25,7 +25,7 @@
if {$count == 1} {
append phrase "one $noun"
} else {
- if {[empty_string_p $plural]} {
+ if {$plural eq ""} {
set plural "${noun}s"
}
append phrase "$count $plural"
Index: openacs-4/packages/acs-templating/www/doc/demo/display-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/www/doc/demo/display-edit.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-templating/www/doc/demo/display-edit.tcl 9 Jan 2003 11:55:24 -0000 1.2
+++ openacs-4/packages/acs-templating/www/doc/demo/display-edit.tcl 10 Jan 2007 21:22:13 -0000 1.3
@@ -43,6 +43,6 @@
}
# Choose standard or gridded output
-if { [string equal [element get_value sandwich grid] t] } {
+if {[element get_value sandwich grid] eq "t"} {
ad_return_template sandwich-grid
}
Index: openacs-4/packages/acs-templating/www/doc/demo/fibo-master.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/www/doc/demo/fibo-master.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-templating/www/doc/demo/fibo-master.tcl 13 Mar 2001 22:59:27 -0000 1.1
+++ openacs-4/packages/acs-templating/www/doc/demo/fibo-master.tcl 10 Jan 2007 21:22:13 -0000 1.2
@@ -1 +1 @@
-set color [format "%.6x" [expr 0xd53feb * $level & 0xffffff | 0x808080]]
+set color [format "%.6x" [expr {0xd53feb * $level & 0xffffff | 0x808080}]]
Index: openacs-4/packages/acs-templating/www/doc/demo/fibo.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/www/doc/demo/fibo.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-templating/www/doc/demo/fibo.tcl 13 Mar 2001 22:59:27 -0000 1.1
+++ openacs-4/packages/acs-templating/www/doc/demo/fibo.tcl 10 Jan 2007 21:22:13 -0000 1.2
@@ -1,2 +1,2 @@
-set one_less [expr $n - 1]
-set two_less [expr $n - 2]
\ No newline at end of file
+set one_less [expr {$n - 1}]
+set two_less [expr {$n - 2}]
\ No newline at end of file
Index: openacs-4/packages/acs-templating/www/doc/demo/list.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/www/doc/demo/list.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/acs-templating/www/doc/demo/list.tcl 13 Mar 2001 22:59:27 -0000 1.1
+++ openacs-4/packages/acs-templating/www/doc/demo/list.tcl 10 Jan 2007 21:22:13 -0000 1.2
@@ -6,5 +6,5 @@
# should be onelist, but ad_page_contract does not understand that
for {set f 1; set n 1} {$n < 12} {incr n} {
- lappend factorial [set f [expr $f*$n]]
+ lappend factorial [set f [expr {$f*$n}]]
}
Index: openacs-4/packages/acs-templating/www/doc/demo/sandwich.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/www/doc/demo/sandwich.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-templating/www/doc/demo/sandwich.tcl 10 Sep 2002 22:22:16 -0000 1.2
+++ openacs-4/packages/acs-templating/www/doc/demo/sandwich.tcl 10 Jan 2007 21:22:13 -0000 1.3
@@ -31,6 +31,6 @@
}
# Choose standard or gridded output
-if { [string equal [element get_value sandwich grid] t] } {
+if {[element get_value sandwich grid] eq "t"} {
ad_return_template sandwich-grid
}
Index: openacs-4/packages/acs-templating/www/doc/demo/user-edit.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/www/doc/demo/user-edit.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-templating/www/doc/demo/user-edit.tcl 20 Feb 2002 21:07:13 -0000 1.3
+++ openacs-4/packages/acs-templating/www/doc/demo/user-edit.tcl 10 Jan 2007 21:22:13 -0000 1.4
@@ -19,7 +19,7 @@
set user_search [element get_value user_search user_search]
# the main logic depends on whether the request includes a user ID or not.
-if { ! [string equal $user_id {}] } {
+if { $user_id ne {} } {
# the request included a user ID
set display "user_edit"
@@ -28,7 +28,7 @@
# handle a missing user ID
- if { [string equal $user_search {}] } {
+ if {$user_search eq {}} {
# no user search string returned.
set display "user_search"
@@ -79,7 +79,7 @@
}
# return without instantiating the edit form if we don't know the user_id yet
-if { $display != "user_edit" } {
+if { $display ne "user_edit" } {
return
}
Index: openacs-4/packages/acs-templating/www/doc/exercise/form-sample.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/www/doc/exercise/form-sample.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-templating/www/doc/exercise/form-sample.tcl 22 Aug 2002 03:13:24 -0000 1.3
+++ openacs-4/packages/acs-templating/www/doc/exercise/form-sample.tcl 10 Jan 2007 21:22:13 -0000 1.4
@@ -55,11 +55,11 @@
set start_row [ns_queryget start_row]
-if { $start_row == "" } {
+if { $start_row eq "" } {
set start_row 1
}
-if {![info exists num_rows] || [string trim $num_rows] != ""} {
+if {![info exists num_rows] || [string trim $num_rows] ne ""} {
set num_rows 5
}
@@ -117,14 +117,14 @@
set rowcount [set address:rowcount]
-if { $rowcount > [expr $start_row + $num_rows] } {
- set next_set [expr $start_row + $num_rows]
+if { $rowcount > [expr {$start_row + $num_rows}] } {
+ set next_set [expr {$start_row + $num_rows}]
} else {
set next_set ""
}
if { $start_row > 1 } {
- set previous_set [expr $start_row - $num_rows]
+ set previous_set [expr {$start_row - $num_rows}]
} else {
set previous_set ""
}
@@ -133,8 +133,8 @@
set previous_set 1
}
-if {$rowcount > [expr $next_set + $num_rows]} {
- set last_set [expr $rowcount - ($rowcount % $num_rows)]
+if {$rowcount > [expr {$next_set + $num_rows}]} {
+ set last_set [expr {$rowcount - ($rowcount % $num_rows)}]
} else {
set last_set ""
}
Index: openacs-4/packages/acs-templating/www/doc/exercise/list-and-var-sample.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/www/doc/exercise/list-and-var-sample.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/acs-templating/www/doc/exercise/list-and-var-sample.tcl 22 Aug 2002 03:13:24 -0000 1.3
+++ openacs-4/packages/acs-templating/www/doc/exercise/list-and-var-sample.tcl 10 Jan 2007 21:22:13 -0000 1.4
@@ -42,7 +42,7 @@
# First, let's set the name variable, which can be displayed in your template using
# the @name@ marker
-#if {![info exists name] || $name == ""} {
+#if {![info exists name] || $name eq ""} {
set name "(Your Name)"
#}
Index: openacs-4/packages/acs-templating/www/resources/xinha-nightly/plugins/OacsFs/popups/file-selector.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/www/resources/xinha-nightly/plugins/OacsFs/popups/file-selector.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/acs-templating/www/resources/xinha-nightly/plugins/OacsFs/popups/file-selector.tcl 4 Jun 2006 00:45:54 -0000 1.2
+++ openacs-4/packages/acs-templating/www/resources/xinha-nightly/plugins/OacsFs/popups/file-selector.tcl 10 Jan 2007 21:22:13 -0000 1.3
@@ -101,7 +101,7 @@
set upload_tmpfile [template::util::file::get_property tmp_filename $upload_file]
set mime_type [template::util::file::get_property mime_type $upload_file]
- if {$selector_type eq "image" && ![string match image/* $mime_type]} {
+ if {$selector_type eq "image" && ![string match "image/*" $mime_type]} {
template::form::set_error upload_form upload_file \
[_ acs-templating.HTMLArea_SelectImageUploadNoImage]
break
@@ -249,7 +249,7 @@
set file_upload_name [fs::remove_special_file_system_characters \
-string $file_upload_name]
- if { ![empty_string_p $content_size] } {
+ if { $content_size ne "" } {
incr content_size_total $content_size
}
Index: openacs-4/packages/search/tcl/search-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/search/tcl/search-procs.tcl,v
diff -u -r1.38 -r1.39
--- openacs-4/packages/search/tcl/search-procs.tcl 16 Nov 2006 12:43:40 -0000 1.38
+++ openacs-4/packages/search/tcl/search-procs.tcl 10 Jan 2007 21:22:14 -0000 1.39
@@ -24,8 +24,8 @@
@author Jeff Davis (davis@xarg.net)
} {
- if {![empty_string_p $object_id]
- && ![empty_string_p $event]} {
+ if {$object_id ne ""
+ && $event ne ""} {
package_exec_plsql \
-var_list [list \
[list object_id $object_id] \
@@ -49,9 +49,9 @@
@author Jeff Davis (davis@xarg.net)
} {
- if {![empty_string_p $object_id]
- && ![empty_string_p $event_date]
- && ![empty_string_p $event]} {
+ if {$object_id ne ""
+ && $event_date ne ""
+ && $event ne ""} {
package_exec_plsql \
-var_list [list [list object_id $object_id] \
[list event_date $event_date] \
@@ -266,7 +266,7 @@
set return_list [list]
foreach value $values {
- if {[string compare $default $value] == 0} {
+ if {$default eq $value } {
lappend return_list "<font color=\"\#a90a08\"><strong>[lindex $items $count]</strong></font>"
} else {
lappend return_list "<a href=\"[lindex $links $count]\"><font color=\"\#000000\">[lindex $items $count]</font></a>"
Index: openacs-4/packages/search/tcl/syndicate-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/search/tcl/syndicate-procs.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/search/tcl/syndicate-procs.tcl 29 Mar 2005 23:39:45 -0000 1.1
+++ openacs-4/packages/search/tcl/syndicate-procs.tcl 10 Jan 2007 21:22:14 -0000 1.2
@@ -19,7 +19,7 @@
if {![parameter::get -boolean -package_id [apm_package_id_from_key search] -parameter Syndicate -default 0]} {
return
}
- if {[string equal $action DELETE]} {
+ if {$action eq "DELETE"} {
db_dml nuke {delete from syndication where object_id = :object_id}
} else {
upvar $datasource d
Index: openacs-4/packages/search/www/search.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/search/www/search.tcl,v
diff -u -r1.24 -r1.25
--- openacs-4/packages/search/www/search.tcl 15 Dec 2006 00:02:18 -0000 1.24
+++ openacs-4/packages/search/www/search.tcl 10 Jan 2007 21:22:14 -0000 1.25
@@ -43,18 +43,18 @@
# Ugly .LRNism: guests must not search for people. Here's the security
# check that makes sure they cannot fiddle around with the URL
- if {$is_guest_p && [string equal $object_type "phb_person"]} {
+ if {$is_guest_p && $object_type eq "phb_person"} {
ad_return_error "Security Breakin!" "Security Alert. This incident has been logged."
}
}
-if { [array get info] == "" } {
+if { [array get info] eq "" } {
ReturnHeaders
ns_write "[_ search.lt_FtsEngineDriver_not_a]"
ad_script_abort
}
-if {[string equal "" [string trim $q]]} {
+if {"" eq [string trim $q]} {
set query {}
set empty_p 1
set url_advanced_search "advanced-search"
@@ -80,15 +80,15 @@
set df ""
set dt ""
-if { $dfs == "all" } {
+if { $dfs eq "all" } {
set dfs ""
}
array set symbol2interval [ad_parameter -package_id $package_id Symbol2Interval]
-if { $dfs != "" } {
+if { $dfs ne "" } {
set df [db_exec_plsql get_df "select now() + '$symbol2interval($dfs)'::interval"]
}
-if { $dts != "" } {
+if { $dts ne "" } {
set dt [db_exec_plsql get_dt "select now() + '$symbol2interval($dts)'::interval"]
}
@@ -108,12 +108,12 @@
set t0 [clock clicks -milliseconds]
# TODO calculate subsite or dotlrn package_ids
-if {![string equal "this" $scope]} {
+if {"this" ne $scope } {
# don't send package_id if its not searching this package
set search_package_id ""
} else {
set search_node_id [site_node::get_node_id_from_object_id -object_id $search_package_id]
- if {[string equal "dotlrn" [site_node::get_element -node_id $search_node_id -element package_key]]} {
+ if {"dotlrn" eq [site_node::get_element -node_id $search_node_id -element package_key]} {
set search_package_id [site_node::get_children -node_id $search_node_id -element package_id]
}
}
@@ -129,7 +129,7 @@
}
set tend [clock clicks -milliseconds]
-if { $t == "Feeling Lucky" && $result(count) > 0} {
+if { $t eq "Feeling Lucky" && $result(count) > 0} {
set object_id [lindex $result(ids) 0]
set object_type [acs_object_type $object_id]
if {[callback::impl_exists -impl -callback search::url]} {
@@ -141,10 +141,10 @@
ad_script_abort
}
-set elapsed [format "%.02f" [expr double(abs($tend - $t0)) / 1000.0]]
+set elapsed [format "%.02f" [expr {double(abs($tend - $t0)) / 1000.0}]]
if { $offset >= $result(count) } { set offset [expr ($result(count) / $limit) * $limit] }
-set low [expr $offset + 1]
-set high [expr $offset + $limit]
+set low [expr {$offset + 1}]
+set high [expr {$offset + $limit}]
if { $high > $result(count) } { set high $result(count) }
if { $info(automatic_and_queries_p) && ([lsearch -exact $q and] > 0) } {
set and_queries_notice_p 1
@@ -165,7 +165,7 @@
template::multirow create searchresult title_summary txt_summary url_one object_id
-for { set __i 0 } { $__i < [expr $high - $low +1] } { incr __i } {
+for { set __i 0 } { $__i < [expr {$high - $low +1}] } { incr __i } {
set object_id [lindex $result(ids) $__i]
set object_type [acs_object_type $object_id]
@@ -191,17 +191,17 @@
set from_result_page 1
set current_result_page [expr ($low / $limit) + 1]
-set to_result_page [expr ceil(double($result(count)) / double($limit))]
+set to_result_page [expr {ceil(double($result(count)) / double($limit))}]
set url_previous ""
set url_next ""
append url_previous "search?q=${urlencoded_query}&search_package_id=$search_package_id"
append url_next "search?q=${urlencoded_query}&search_package_id=$search_package_id"
-if { [expr $current_result_page - 1] > $from_result_page } {
+if { [expr {$current_result_page - 1}] > $from_result_page } {
append url_previous "&offset=[expr ($current_result_page - 2) * $limit]"
}
if { $current_result_page < $to_result_page } {
- append url_next "&offset=[expr $current_result_page * $limit]"
+ append url_next "&offset=[expr {$current_result_page * $limit}]"
}
if { $num > 0 } {
append url_previous "&num=$num"
@@ -224,7 +224,7 @@
}
set search_the_web [ad_parameter -package_id $package_id SearchTheWeb]
-if [llength $search_the_web] {
+if {[llength $search_the_web]} {
set stw ""
foreach {url site} $search_the_web {
append stw "<a href=\"[format $url $urlencoded_query]\">$site</a> "
Index: openacs-4/packages/search/www/admin/index-missing-objects.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/search/www/admin/Attic/index-missing-objects.tcl,v
diff -u -r1.1 -r1.2
--- openacs-4/packages/search/www/admin/index-missing-objects.tcl 8 Nov 2005 18:24:08 -0000 1.1
+++ openacs-4/packages/search/www/admin/index-missing-objects.tcl 10 Jan 2007 21:22:14 -0000 1.2
@@ -7,7 +7,7 @@
} -properties {
}
-if {[string equal $object_type "file_storage_object"]} {
+if {$object_type eq "file_storage_object"} {
db_dml reindex_file_storage_object {
insert into search_observer_queue (object_id, event)
select object_id, 'INSERT' from acs_objects, cr_items
Index: openacs-4/tcl/0-acs-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/tcl/0-acs-init.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/tcl/0-acs-init.tcl 11 Dec 2003 21:40:16 -0000 1.5
+++ openacs-4/tcl/0-acs-init.tcl 10 Jan 2007 21:22:14 -0000 1.6
@@ -20,7 +20,7 @@
# Check that the appropriate version of tDom (http://www.tdom.org) is installed
# and spit out a comment or try to install it if not.
- if {[string equal {} [info commands domNode]]} {
+ if {{} eq [info commands domNode]} {
if {[ns_info version] < 4} {
ns_log Error "0-acs-init.tcl: domNode command not found -- libtdom.so not loaded?"
} elseif {[ns_info version] >= 4} {
Index: openacs-4/www/blank-master.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/www/blank-master.tcl,v
diff -u -r1.20 -r1.21
--- openacs-4/www/blank-master.tcl 20 Jul 2006 03:30:43 -0000 1.20
+++ openacs-4/www/blank-master.tcl 10 Jan 2007 21:22:14 -0000 1.21
@@ -71,7 +71,7 @@
}
}
-if {![empty_string_p $onload]} {
+if {$onload ne ""} {
multirow append attribute onload [join $onload " "]
}
@@ -117,7 +117,7 @@
# Toggle translator mode link
set acs_lang_url [apm_package_url_from_key "acs-lang"]
-if { [empty_string_p $acs_lang_url] } {
+if { $acs_lang_url eq "" } {
set lang_admin_p 0
} else {
set lang_admin_p [permission::permission_p \
Index: openacs-4/www/login-status.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/www/login-status.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/www/login-status.tcl 17 May 2003 12:51:57 -0000 1.2
+++ openacs-4/www/login-status.tcl 10 Jan 2007 21:22:14 -0000 1.3
@@ -6,7 +6,7 @@
set pvt_home_url [ad_pvt_home]
-if { [string equal [ad_conn url] $pvt_home_url] } {
+if {[ad_conn url] eq $pvt_home_url} {
set pvt_home_url {}
}
Index: openacs-4/www/site-master.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/www/site-master.tcl,v
diff -u -r1.22 -r1.23
--- openacs-4/www/site-master.tcl 13 Jul 2006 04:06:42 -0000 1.22
+++ openacs-4/www/site-master.tcl 10 Jan 2007 21:22:14 -0000 1.23
@@ -27,7 +27,7 @@
# Get system name
set system_name [ad_system_name]
set system_url [ad_url]
-if { [string equal [ad_conn url] "/"] } {
+if {[ad_conn url] eq "/"} {
set system_url ""
}