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 "$name" + } 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 "$name" - } else { - set creator "Nobody" - } - append result "

$timeshort \ - [my encode $creator:]\ - [my encode $msg]

\n" + append result "

$timeshort[my user_link $user_id $color]:[my encode $msg]

\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]" + } }