Forum OpenACS Q&A: Re: Response to HELP I need sound allert on chat
This is my ad-defs.tcl.preload (sorry for the large text file):
# /tcl/ad-defs.tcl
#
# Author: mailto:philg@arsdigita.com on April 2, 1998
#
# ArsDigita Community System Defs
#
# ad-defs.tcl.preload,v 3.6.2.3 2000/03/17 05:56:11 aure Exp
# -----------------------------------------------------------------------------
# The following two procs use the ACS release tag to return the
# current version and release date. In a development copy of acs the
# release tag is not expanded and these procs return "development" and
# "not released". In a released copy the tag is expanded to something
# of the form "acs-major-minor-release-Ryyyymmdd", and these procs
# return e.g. "3.1.3" and "February 20, 2000".
util_report_library_entry
proc ad_acs_version {} {
set release_tag {acs-3-2-2-R20000412}
regexp "acs-(\[0-9\]+)-(\[0-9\]+)-(\[0-9\]+)" \
$release_tag match major minor release
if {[info exists major] && [info exists minor] && [info exists release]} {
return "$major.$minor.$release"
} else {
return "development"
}
}
proc ad_acs_release_date {} {
set release_tag {acs-3-2-2-R20000412}
regexp "R(\[0-9\]+)" $release_tag match release_date
if {[info exists release_date]} {
set year [string range $release_date 0 3]
set month [string range $release_date 4 5]
set day [string range $release_date 6 7]
return [util_AnsiDatetoPrettyDate "$year-$month-$day"]
} else {
return "not released"
}
}
# for setting cookies that will work on, e.g.,
# http://www.foobar.com and http://foobar.com
# we need to push user through the cookie-chain.tcl
# pipeline and use both host names explicitly
proc ad_need_cookie_chain_p {} {
return [ad_parameter NeedCookieChainP]
}
proc ad_cookie_chain_first_host_name {} {
return [ad_parameter CookieChainFirstHostName]
}
proc ad_cookie_chain_second_host_name {} {
return [ad_parameter CookieChainSecondHostName]
}
# this is a technical person who can fix problems
proc ad_host_administrator {} {
return [ad_parameter HostAdministrator]
}
# set to return 1 if there is a graphics site
proc ad_graphics_site_available_p {} {
return [ad_parameter GraphicsSiteAvailableP]
}
# this is the main name of the Web service that you're offering
# on top of the Arsdigita Web Publishing System
proc ad_system_name {} {
return [ad_parameter SystemName]
}
# This is the URL of a user's private workspace on the system, usually
# /pvt/home.tcl
proc ad_pvt_home {} {
return "/pvt/home.tcl"
}
proc ad_pvt_home_name {} {
return "workspace"
}
proc ad_pvt_home_link {} {
return "<a href=\"/pvt/home.tcl\">your workspace</a>"
}
proc ad_site_home_link {} {
if { [ad_get_user_id] != 0 } {
return "<a href=\"/pvt/home.tcl\">[ad_system_name]</a>"
} else {
# we don't know who this person is
return "<a href=\"/\">[ad_system_name]</a>"
}
}
# person who owns the service
# this person would be interested in user feedback, etc.
proc ad_system_owner {} {
return [ad_parameter SystemOwner]
}
# a human-readable name of the publisher, suitable for
# legal blather
proc ad_publisher_name {} {
return [ad_parameter PublisherName]
}
proc ad_url {} {
# this will be called by email alerts. Do not use ns_conn location
return [ad_parameter SystemURL]
}
proc ad_present_user {user_id name} {
return "<a href=\"/shared/community-member.tcl?user_id=$user_id\">$name</a>"
}
proc ad_admin_present_user {user_id name} {
return "<a href=\"/admin/users/one.tcl?user_id=$user_id\">$name</a>"
}
proc_doc ad_header {page_title {extra_stuff_for_document_head ""}} "writes HEAD, TITLE, and BODY t
if {[ad_parameter MenuOnUserPagesP pdm] == 1} {
return [ad_header_with_extra_stuff $page_title [ad_pdm] [ad_pdm_spacer]]
} else {
return [ad_header_with_extra_stuff $page_title $extra_stuff_for_document_head]
}
}
proc_doc ad_header_with_extra_stuff {page_title {extra_stuff_for_document_head ""} {pre_content_ht
set html "<html>
<head>
$extra_stuff_for_document_head
<title>$page_title</title>
<script language=\"javascript\">
<!--
function showShortmessage(strAction) {
if (!strAction) strAction = \"\";
jetzt = new Date();
instWindow=window.open(\"/popup/instant-message.tcl?action=\"+strAction, \"Instantmessage\", \
instWindow.focus();
}
[ad_decode [ad_verify_and_get_user_id] "0" "" "
function mailReload() {
mailswap=new Image();
mailswap.src=\"/redirect/mailcheck.tcl\";
mailcheck();
}
function mailcheck() {
if (mailswap.complete) {
if (mailswap.width==5) {
showShortmessage();
}
window.setTimeout(\"mailReload()\",30000)
} else {
//Image not loaded yet
window.setTimeout(\"mailcheck()\",1000)
}
}
mailReload();
"]
// -->
</script>
</head>
"
if { [info exists prefer_text_only_p] && $prefer_text_only_p == "f" && [ad_graphics_site_avail
append html "<body bgcolor=\"[ad_parameter bgcolor "" "white"]\" background=\"[ad_paramete
} else {
append html "<body bgcolor=[ad_parameter bgcolor "" "white"] text=[ad_parameter textcolor
}
append html $pre_content_html
return $html
}
proc_doc ad_footer {{signatory ""} {suppress_curriculum_bar_p 0}} "writes a horizontal rule, a mai
global sidegraphic_displayed_p
if [empty_string_p $signatory] {
set signatory [ad_system_owner]
}
if { [info exists sidegraphic_displayed_p] && $sidegraphic_displayed_p } {
# we put in a BR CLEAR=RIGHT so that the signature will clear any side graphic
# from the ad-sidegraphic.tcl package
set extra_br "<br clear=right>"
} else {
set extra_br ""
}
if { [ad_parameter EnabledP curriculum 0] && [ad_parameter StickInFooterP curriculum 0] && !$s
set curriculum_bar "<center>[curriculum_bar]</center>"
} else {
set curriculum_bar ""
}
return "
$extra_br
$curriculum_bar
<hr>
<a href=\"mailto:$signatory\"><address>$signatory</address></a>
</body>
</html>"
}
# need special headers and footers for admin pages
# notably, we want pages signed by someone different
# (the user-visible pages are probably signed by
# mailto:webmaster@yourdomain.com; the admin pages are probably
# used by this person or persons. If they don't like
# the way a page works, they should see a link to the
# email address of the programmer who can fix the page).
proc ad_admin_owner {} {
return [ad_parameter AdminOwner]
}
proc_doc ad_admin_header {page_title {db ""}} "" {
if {[ad_parameter MenuOnAdminPagesP pdm] == 1} {
return [ad_header_with_extra_stuff $page_title [ad_pdm "admin" 5 5 $db] [ad_pdm_spacer "ad
} else {
return [ad_header_with_extra_stuff $page_title]
}
}
proc_doc ad_admin_footer {} "Signs pages with ad_admin_owner (usually a programmer who can fix bug
return "<hr>
<a href=\"mailto:[ad_admin_owner]\"><address>[ad_admin_owner]</address></a>
</body>
</html>"
}
proc_doc ad_return_complaint {exception_count exception_text} "Return a page complaining about the
# there was an error in the user input
if { $exception_count == 1 } {
set problem_string "a problem"
set please_correct "it"
} else {
set problem_string "some problems"
set please_correct "them"
}
ns_return 200 text/html "[ad_header_with_extra_stuff "Problem with Your Input" "" ""]
<h2>Problem with Your Input</h2>
to <a href=/>[ad_system_name]</a>
<hr>
We had $problem_string processing your entry:
<ul>
$exception_text
</ul>
Please back up using your browser, correct $please_correct, and
resubmit your entry.
<p>
Thank you.
[ad_footer]
"}
proc ad_return_error {title explanation} {
ns_return 500 text/html "[ad_header_with_extra_stuff $title "" ""]
<h2>$title</h2>
<hr>
$explanation
[ad_footer]"
}
# like the above proc, but w/status 200 because it's just a warning
proc ad_return_warning {title explanation} {
ns_return 200 text/html "[ad_header_with_extra_stuff $title "" ""]
<h2>$title</h2>
<hr>
$explanation
[ad_footer]"
}
proc_doc ad_return_if_another_copy_is_running {{max_simultaneous_copies 1} {call_adp_break_p 0}} {
# first let's figure out how many are running and queued
set this_connection_url [ns_conn url]
set n_matches 0
foreach connection [ns_server active] {
set query_connection_url [lindex $connection 4]
if { $query_connection_url == $this_connection_url } {
# we got a match (we'll always get at least one
# since we should match ourselves)
incr n_matches
}
}
if { $n_matches > $max_simultaneous_copies } {
ad_return_warning "Too many copies" "This is an expensive page for our server, which is al
# blow out of the caller as well
if $call_adp_break_p {
# we were called from an ADP page; we have to abort processing
ns_adp_break
}
return -code return
}
# we're okay
return 1
}
proc ad_record_query_string {query_string db subsection n_results {user_id "NULL"}} {
if { $user_id == 0 } {
set user_id "NULL"
}
ns_db dml $db "insert into query_strings
(query_date, query_string, subsection, n_results, user_id)
values
([db_sysdate], '[DoubleApos $query_string]', '[DoubleApos $subsection]', $n_results, $user_id)"
}
proc ad_pretty_mailing_address_from_args {db line1 line2 city state postal_code country_code} {
set lines [list]
if [empty_string_p $line2] {
lappend lines $line1
} elseif [empty_string_p $line1] {
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" } {
lappend lines [ad_country_name_from_country_code $db $country_code]
}
return [join $lines "\n"]
}
# this relies on the variable $db being set already
proc_doc ad_get_user_info {} {Sets first_name, last_name, email in the environment of its caller.}
uplevel {set user_id [ad_get_user_id]
if [catch {set selection [ns_db 1row $db "select * from users where user_id=$user_id"]} errmsg
ad_return_error "Couldn't find user info" "Couldn't find user info."
return
}
set_variables_after_query
}
}
# for pages that have optional decoration
proc_doc ad_decorate_top {simple_headline potential_decoration} "Use this for pages that might or
if [empty_string_p $potential_decoration] {
return $simple_headline
} else {
return "<table cellspacing=10><tr><td>$potential_decoration<td>$simple_headline</tr></tabl
}
}
proc_doc ad_parameter {name {subsection ""} {default ""}} {Returns the value of a configuration pa
set server_name [ns_info server]
append config_path "ns/server/" $server_name "/acs"
if ![empty_string_p $subsection] {
append config_path "/$subsection"
}
set config_value [ns_config $config_path $name]
if ![empty_string_p $config_value] {
return $config_value
} else {
return $default
}
}
proc_doc ad_parameter_section {{subsection ""}} {Returns all the vars in a parameter section as an
set server_name [ns_info server]
append config_path "ns/server/" $server_name "/acs"
if ![empty_string_p $subsection] {
append config_path "/$subsection"
}
set what_aolserver_gave_us [ns_configsection $config_path]
if [empty_string_p $what_aolserver_gave_us] {
return [ns_set new "empty set for config section"]
} else {
return $what_aolserver_gave_us
}
}
# returns particular parameter values as a Tcl list (i.e., it selects
# out those with a certain key)
proc ad_parameter_all_values_as_list {name {subsection ""}} {
set server_name [ns_info server]
append config_path "ns/server/" $server_name "/acs"
if ![empty_string_p $subsection] {
append config_path "/$subsection"
}
set the_set [ns_configsection $config_path]
if [empty_string_p $the_set] {
return [list]
}
set the_values [list]
for {set i 0} {$i < [ns_set size $the_set]} {incr i} {
if { [ns_set key $the_set $i] == $name } {
lappend the_values [ns_set value $the_set $i]
}
}
return $the_values
}
util_report_successful_library_load
