Index: openacs-4/packages/xotcl-core/catalog/xotcl-core.de_DE.ISO-8859-1.xml
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/catalog/xotcl-core.de_DE.ISO-8859-1.xml,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/xotcl-core/catalog/xotcl-core.de_DE.ISO-8859-1.xml 19 Jan 2006 22:57:37 -0000 1.2
+++ openacs-4/packages/xotcl-core/catalog/xotcl-core.de_DE.ISO-8859-1.xml 30 Mar 2006 00:35:18 -0000 1.3
@@ -1,9 +1,10 @@
<?xml version="1.0" encoding="ISO-8859-1"?>
-<message_catalog package_key="xotcl-core" package_version="0.30" locale="de_DE" charset="ISO-8859-1">
+<message_catalog package_key="xotcl-core" package_version="0.36" locale="de_DE" charset="ISO-8859-1">
<msg key="add">Neu: %type%</msg>
<msg key="add_long">Neue Seite vom Type %type% erzeugen</msg>
<msg key="edit_item">Editieren</msg>
+ <msg key="has_entered_the_room">has entered the room</msg>
<msg key="live_revision">Aktuelle Version</msg>
<msg key="revision_title">Versionen des Eintrags</msg>
<msg key="revisions">Verlauf</msg>
Index: openacs-4/packages/xotcl-core/catalog/xotcl-core.en_US.ISO-8859-1.xml
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/catalog/xotcl-core.en_US.ISO-8859-1.xml,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/xotcl-core/catalog/xotcl-core.en_US.ISO-8859-1.xml 19 Jan 2006 22:57:37 -0000 1.2
+++ openacs-4/packages/xotcl-core/catalog/xotcl-core.en_US.ISO-8859-1.xml 30 Mar 2006 00:35:19 -0000 1.3
@@ -1,9 +1,10 @@
<?xml version="1.0" encoding="ISO-8859-1"?>
-<message_catalog package_key="xotcl-core" package_version="0.30" locale="en_US" charset="ISO-8859-1">
+<message_catalog package_key="xotcl-core" package_version="0.36" locale="en_US" charset="ISO-8859-1">
<msg key="add">Add %type%</msg>
<msg key="add_long">Add new item of type %type%</msg>
<msg key="edit_item">Edit Item</msg>
+ <msg key="has_entered_the_room">has entered the room</msg>
<msg key="live_revision">Live Revision</msg>
<msg key="revision_title">Revisions of Entry</msg>
<msg key="revisions">Revisions</msg>
Index: openacs-4/packages/xotcl-core/tcl/05-doc-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/Attic/05-doc-procs.tcl,v
diff -u -r1.5 -r1.6
--- openacs-4/packages/xotcl-core/tcl/05-doc-procs.tcl 30 Dec 2005 00:04:44 -0000 1.5
+++ openacs-4/packages/xotcl-core/tcl/05-doc-procs.tcl 30 Mar 2006 00:35:19 -0000 1.6
@@ -17,7 +17,9 @@
# so we add the specified methods explizitely to the export list
::Serializer exportMethods {
::xotcl::Object instproc ad_proc
+ ::xotcl::Object instproc ad_forward
::xotcl::Class instproc ad_instproc
+ ::xotcl::Class instproc ad_instforward
::xotcl::Object instproc ad_doc
::xotcl::Object instproc __api_make_doc
::xotcl::Object instproc __api_make_forward_doc
Index: openacs-4/packages/xotcl-core/tcl/chat-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/Attic/chat-procs.tcl,v
diff -u -r1.2 -r1.3
--- openacs-4/packages/xotcl-core/tcl/chat-procs.tcl 24 Mar 2006 18:17:37 -0000 1.2
+++ openacs-4/packages/xotcl-core/tcl/chat-procs.tcl 30 Mar 2006 00:35:19 -0000 1.3
@@ -7,15 +7,15 @@
}
namespace eval ::xo {
- Class Message -parameter {time user_id msg }
+ Class Message -parameter {time user_id msg color}
Class Chat -superclass ::xo::OrderedComposite \
-parameter {chat_id user_id session_id
- {encoder urlencode} {timewindow 600} {sweepinterval 60}
+ {encoder urlencode} {timewindow 600} {sweepinterval 600}
}
Chat instproc init {} {
my instvar array
- my log "-- "
+ # my log "-- "
my set now [clock clicks -milliseconds]
if {![my exists user_id]} {my set user_id [ad_conn user_id]}
if {![my exists session_id]} {my set session_id [ad_conn session_id]}
@@ -28,28 +28,33 @@
[ad_schedule_proc -thread "t" [my sweepinterval] $cls sweep_all_chats]
}
if {![nsv_exists $array-seen newest]} {nsv_set $array-seen newest 0}
+ if {![nsv_exists $array-color idx]} {nsv_set $array-color idx 0}
+ my init_user_color
}
Chat instproc add_msg {{-get_new:boolean true} -uid msg} {
my instvar array now
set user_id [expr {[info exists uid] ? $uid : [my set user_id]}]
set msg_id $now.$user_id
- nsv_set $array $msg_id [list $now [clock seconds] $user_id $msg]
+ if { ![nsv_exists $array-login $user_id] } {
+ nsv_set $array-login $user_id [clock seconds]
+ }
+ nsv_set $array $msg_id [list $now [clock seconds] $user_id $msg [my set user_color]]
nsv_set $array-seen newest $now
nsv_set $array-seen last [clock seconds] ;#### PETER?
nsv_set $array-last-activity $user_id $now
if {$get_new} {my get_new}
}
Chat instproc active_user_list {} {
- nsv_array get [my set array]-last-activity
+ nsv_array get [my set array]-login
}
Chat instproc nr_active_users {} {
- expr { [llength [nsv_array get [my set array]-last-activity]] / 2 }
+ expr { [llength [nsv_array get [my set array]-login]] / 2 }
}
Chat instproc last_activity {} {
- if { ![nsv_exists [my set array]-seen last] } { return "" }
+ if { ![nsv_exists [my set array]-seen last] } { return "-" }
return [clock format [nsv_get [my set array]-seen last] -format "%d.%m.%y %H:%M:%S"]
}
@@ -68,9 +73,9 @@
if {[nsv_get $array-seen newest]>$last} {
#my log "--c must check $session_id: [nsv_get $array-seen newest] > $last"
foreach {key value} [nsv_array get $array] {
- foreach {timestamp secs user msg} $value break
+ foreach {timestamp secs user msg color} $value break
if {$timestamp > $last} {
- my add [Message new -time $secs -user_id $user -msg $msg]
+ my add [Message new -time $secs -user_id $user -msg $msg -color $color]
} else {
my check_age $key [expr {($now - $timestamp) / 1000}]
}
@@ -85,9 +90,9 @@
Chat instproc get_all {} {
my instvar array now session_id
foreach {key value} [nsv_array get $array] {
- foreach {timestamp secs user msg} $value break
+ foreach {timestamp secs user msg color} $value break
if {[my check_age $key [expr {($now - $timestamp) / 1000}]]} {
- my add [Message new -time $secs -user_id $user -msg $msg]
+ my add [Message new -time $secs -user_id $user -msg $msg -color $color]
}
}
#my log "--c setting session_id $session_id: $now"
@@ -104,8 +109,10 @@
ns_log Notice "YY Checking: now=$now, timestamp=$timestamp, ago=$ago"
# was 1200
if {$ago > 300} {
- my add_msg -get_new false -uid $user "auto logout"
- nsv_unset $array-last-activity $user
+ my add_msg -get_new false -uid $user "auto logout"
+ nsv_unset $array-last-activity $user
+ nsv_unset $array-login $user
+ nsv_unset $array-color $user
}
}
my log "-- ending"
@@ -114,43 +121,70 @@
Chat instproc logout {} {
my instvar array user_id
ns_log Notice "YY User $user_id logging out of chat"
- my add_msg -get_new false [_ xotcl-core.has_left_the_room].
- nsv_unset $array-last-activity $user_id
+ my add_msg -get_new false [_ chat.has_left_the_room].
+ catch {
+ # do not try to clear nsvs, if they are not available
+ # this situation could occur after a server restart, after which the user tries to leave the room
+ nsv_unset $array-last-activity $user_id
+ nsv_unset $array-login $user_id
+ nsv_unset $array-color $user_id
+ }
}
+
+ Chat instproc init_user_color {} {
+ my instvar array user_id
+ if { [nsv_exists $array-color $user_id] } {
+ my set user_color [nsv_get $array-color $user_id]
+ } else {
+ [my info class] instvar colors
+ ns_log notice "getting colors of [my info class] = [info exists colors]"
+ set color [lindex $colors [expr { [nsv_get $array-color idx] % [llength $colors]-1 }]]
+ my set user_color $color
+ nsv_set $array-color $user_id $color
+ nsv_incr $array-color idx
+ }
+ }
Chat instproc login {} {
my instvar array user_id now
# was the user already active?
if {![nsv_exists $array-last-activity $user_id]} {
- my add_msg -get_new false [_ chat.has_entered_the_room]
+ my add_msg -get_new false [_ xotcl-core.has_entered_the_room]
}
my encoder noencode
#my log "--c setting session_id [my set session_id]: $now"
my get_all
}
+ Chat instproc user_link { user_id {color ""} } {
+ if {$user_id > 0} {
+ acs_user::get -user_id $user_id -array user
+ set name [expr {$user(screen_name) ne "" ? $user(screen_name) : $user(name)}]
+ #set name [chat_user_name $user_id]
+ set url "/shared/community-member?user%5fid=$user_id"
+ if { $color eq "" } {
+ set color [my set user_color $user_id]
+ }
+ set creator "<a style='color:$color;' target='_blank' href='$url'>$name</a>"
+ } else {
+ set creator "Nobody"
+ }
+ return [my encode $creator]
+ }
+
Chat instproc urlencode {string} {ns_urlencode $string}
Chat instproc noencode {string} {set string}
Chat instproc encode {string} {my [my encoder] $string}
Chat instproc render {} {
my orderby time
set result ""
- foreach child [my children] {
+ foreach child [my children] {
set msg [$child msg]
set user_id [$child user_id]
+ set color [$child color]
set timelong [clock format [$child time]]
set timeshort [clock format [$child time] -format {[%H:%M:%S]}]
- if {$user_id > 0} {
- acs_user::get -user_id $user_id -array user
- set name [expr {$user(screen_name) ne "" ? $user(screen_name) : $user(name)}]
- set url "/shared/community-member?user%5fid=$user_id"
- set creator "<a target='_parent' href='$url'>$name</a>"
- } else {
- set creator "Nobody"
- }
- append result "<p class='line'><span class='timestamp'>$timeshort</span> \
- <span class='user'> [my encode $creator:]\
- </span><span class='message'> [my encode $msg]</span></p>\n"
+ append result "<p class='line'><span class='timestamp'>$timeshort</span><span class='user'>[my user_link $user_id $color]:</span><span class='message'>[my encode $msg]</span></p>\n"
}
return $result
}
@@ -170,7 +204,7 @@
}
my log "-- ending"
}
-
+
ChatClass method initialize_nsvs {} {
# read the last_activity information at server start into a nsv array
db_foreach get_rooms {
@@ -181,12 +215,15 @@
}
ChatClass method flush_messages {-chat_id:required} {
- set array "[self]-$chat_id"
- nsv_unset $array
- nsv_unset $array-seen
- nsv_unset $array-last-activity
+ set array "[self]-$chat_id"
+ nsv_unset $array
+ nsv_unset $array-seen
+ nsv_unset $array-last-activity
}
-
+ ChatClass method init {} {
+ my set colors [list #006400 #0000ff #b8860b #bdb76b #8b0000]
+ ns_log notice "colors of [self] = [my set colors]"
+ }
}
Index: openacs-4/packages/xotcl-core/tcl/thread_mod-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/Attic/thread_mod-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/xotcl-core/tcl/thread_mod-procs.tcl 24 Mar 2006 12:54:59 -0000 1.6
+++ openacs-4/packages/xotcl-core/tcl/thread_mod-procs.tcl 30 Mar 2006 00:35:19 -0000 1.7
@@ -97,8 +97,11 @@
}
################## main thread support ##################
-::xotcl::RecreationClass create ::xotcl::THREAD \
- -instrecreate 1 \
+#::xotcl::RecreationClass create ::xotcl::THREAD \
+# -instrecreate 1 \
+# -parameter {{persistent 0}}
+
+Class create ::xotcl::THREAD \
-parameter {{persistent 0}}
#Class create ::xotcl::THREAD \
@@ -180,7 +183,7 @@
# lazy creation of a new slave thread
thread::mutex lock [my set mutex]
- my check_blueprint
+ #my check_blueprint
#my log "after lock"
if {![nsv_exists [self class] [self]]} {
set tid [::thread::create]