Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Tightened up on the handling of jids by making use of jidsplit and jidequal |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
8ca38c4784f9ed0a3020819a396002b0 |
User & Date: | patthoyts 2009-04-22 23:15:57.000 |
Context
2009-04-23
| ||
00:54 | removed misguided xml quoting from nicks and fixed a bug that prevented sending to a backslashed nick. check-in: b6d9df0907 user: patthoyts tags: trunk | |
2009-04-22
| ||
23:15 | Tightened up on the handling of jids by making use of jidsplit and jidequal check-in: 8ca38c4784 user: patthoyts tags: trunk | |
2009-04-09
| ||
00:37 | Applied MacOSX patch from Daniel Steffen check-in: d5edbd90fe user: patthoyts tags: trunk | |
Changes
Changes to apps/tkchat/ChangeLog.
1 2 3 4 5 6 7 | 2009-04-09 Pat Thoyts <[email protected]> * tkchat.tcl: Applied MacOSX patch from Daniel Steffen 2009-03-10 Reinhard Max <[email protected]> * tkchat.tcl (::tkchat::DoAnim): Only animate GIF images. | > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 | 2009-04-23 Pat Thoyts <[email protected]> * tkchat.tcl: tighten up our handling of jids by making more use of the jidsplit and jidequal functions. 2009-04-09 Pat Thoyts <[email protected]> * tkchat.tcl: Applied MacOSX patch from Daniel Steffen 2009-03-10 Reinhard Max <[email protected]> * tkchat.tcl (::tkchat::DoAnim): Only animate GIF images. |
︙ | ︙ |
Changes to apps/tkchat/tkchat.tcl.
︙ | ︙ | |||
254 255 256 257 258 259 260 | } } namespace eval ::tkchat { variable chatWindowTitle "The Tcler's Chat" variable HEADUrl {http://tcllib.cvs.sourceforge.net/*checkout*/tcllib/tclapps/apps/tkchat/tkchat.tcl?revision=HEAD} | | | 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 | } } namespace eval ::tkchat { variable chatWindowTitle "The Tcler's Chat" variable HEADUrl {http://tcllib.cvs.sourceforge.net/*checkout*/tcllib/tclapps/apps/tkchat/tkchat.tcl?revision=HEAD} variable rcsid {$Id: tkchat.tcl,v 1.464 2009/04/22 23:15:57 patthoyts Exp $} variable MSGS set MSGS(entered) [list \ "%user% has entered the chat!" \ "Out of a cloud of smoke, %user% appears!" \ "%user% saunters in." \ "%user% wanders in." \ |
︙ | ︙ | |||
5255 5256 5257 5258 5259 5260 5261 | $txt tag configure found -background "#[getColor SearchBG]" $txt tag configure SUBJ -background "#[getColor SubjectBG]" if { $jid eq "All" } { set nicks $Options(NickList) } else { lappend nicks $Options(Nickname) # Is it a conference/nick JID or a user/ressource one? | | | < | 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 5266 5267 5268 5269 5270 | $txt tag configure found -background "#[getColor SearchBG]" $txt tag configure SUBJ -background "#[getColor SubjectBG]" if { $jid eq "All" } { set nicks $Options(NickList) } else { lappend nicks $Options(Nickname) # Is it a conference/nick JID or a user/ressource one? jlib::splitjid $jid conf nick if {[jlib::jidequal $Options(JabberConference) $conf]} { lappend nicks $nick } } foreach nk $nicks { set nk [lindex $nk 0] set clr [getColor $nk] if {[catch {$txt tag configure NICK-$nk -foreground "#$clr"}]} { |
︙ | ︙ | |||
8164 8165 8166 8167 8168 8169 8170 | } } switch -- $type { chat { set from $m(-from) set w .txt | | | < < | | < | | | | | 8163 8164 8165 8166 8167 8168 8169 8170 8171 8172 8173 8174 8175 8176 8177 8178 8179 8180 8181 8182 8183 8184 | } } switch -- $type { chat { set from $m(-from) set w .txt jlib::splitjidex $m(-from) node domain resource if {[jlib::jidequal $node@$domain $conference]} { set from $resource set w [getChatWidget $m(-from) $from] } else { set from $node set w [getChatWidget $m(-from) $from] } LogPrivateChat [normalized_jid $m(-from)] \ $from $timestamp $m(-body) if {$w eq ".txt"} { ::tkchat::addMessage $w $color $from " whispers: $m(-body)" \ ACTION end $timestamp } else { |
︙ | ︙ | |||
8197 8198 8199 8200 8201 8202 8203 | } } ::tkchat::addMessage \ $w $color $from $m(-body) $msgtype end $timestamp } } groupchat { | | < | | | | | | | | | | | 8193 8194 8195 8196 8197 8198 8199 8200 8201 8202 8203 8204 8205 8206 8207 8208 8209 8210 8211 8212 8213 8214 8215 8216 8217 8218 8219 8220 8221 8222 8223 8224 8225 8226 8227 8228 8229 8230 8231 8232 8233 8234 8235 8236 8237 8238 8239 8240 8241 8242 8243 8244 8245 8246 8247 8248 8249 8250 8251 8252 | } } ::tkchat::addMessage \ $w $color $from $m(-body) $msgtype end $timestamp } } groupchat { jlib::splitjidex $m(-from) node domain nick if { [info exists m(-subject)] && $m(-subject) ne ""} { # changing topic. variable ::tkchat::chatWindowTitle variable ::tkchat::MessageCounter set chatWindowTitle "The Tcler's Chat - $m(-subject)" if { $MessageCounter } { wm title . "$MessageCounter - $chatWindowTitle" } else { wm title . $chatWindowTitle } set msg " changed the topic to: $m(-subject)" if { [info exists m(-body)] } { if { [jlib::jidequal $m(-from) $conference] } { ::tkchat::addSystem .txt $m(-body) } else { append msg "\n ... $m(-body)" ::tkchat::addMessage \ .txt $color $nick $msg ACTION end $timestamp } } else { ::tkchat::addMessage .txt \ $color $nick $msg ACTION end $timestamp } } else { if { [info exists m(-body)] && $m(-body) ne ""} { parseMsg $nick $m(-body) $color end $timestamp } else { ::log::log notice "Unknown message from $nick: '$args'" } } } normal { set from $m(-from) jlib::splitjid $m(-from) conf nick if {[jlib::jidequal $conf $conference]} { set from $nick } if { $from eq "ijchain" && $m(-subject) eq "IrcUserList" } { foreach nick $m(-body) { set OnlineUsers(IRC-$nick,status) [list online] lappend OnlineUsers(IRC) $nick } set OnlineUsers(IRC) \ [lsort -dictionary -unique $OnlineUsers(IRC)] ::tkchat::updateOnlineNames return } set subject "" if {[info exists m(-subject)]} { set subject $m(-subject) } set body "" |
︙ | ︙ | |||
8800 8801 8802 8803 8804 8805 8806 | set user $opts(-tojid) set type $opts(-type) } else { # lookup the real nick set found 0 set type $opts(-type) foreach person [$::tkjabber::muc participants $::tkjabber::conference] { | | | 8795 8796 8797 8798 8799 8800 8801 8802 8803 8804 8805 8806 8807 8808 8809 | set user $opts(-tojid) set type $opts(-type) } else { # lookup the real nick set found 0 set type $opts(-type) foreach person [$::tkjabber::muc participants $::tkjabber::conference] { jlib::splitjid $person conf nick if { $nick eq $user } { set user $person set found 1 if {$opts(-echo)} { ::tkchat::addMessage .txt "" $::Options(Username) \ " whispered to $nick: $msg" ACTION end 0 } |
︙ | ︙ | |||
8856 8857 8858 8859 8860 8861 8862 | foreach user $users { $jabber send_message $user -body $msg -type $type -xlist $xlist } #-xlist [wrapper::createtag x -attrlist {xmlns http://tcl.tk/tkchat foo bar}] } | > > > > > > > > > > > > > > | > > > | | | > | | 8851 8852 8853 8854 8855 8856 8857 8858 8859 8860 8861 8862 8863 8864 8865 8866 8867 8868 8869 8870 8871 8872 8873 8874 8875 8876 8877 8878 8879 8880 8881 8882 8883 8884 8885 8886 8887 8888 | foreach user $users { $jabber send_message $user -body $msg -type $type -xlist $xlist } #-xlist [wrapper::createtag x -attrlist {xmlns http://tcl.tk/tkchat foo bar}] } # returns true if a jid is a participant in the conference. proc ::tkjabber::is_participant {jid} { variable muc variable conference foreach participant [$muc participants $conference] { if {[jlib::jidequal $jid $participant]} { return 1 } } return 0 } # Convert a name into a jid. If the argument is a nick then it is converted # to the jid of the user in the conference else return as is. proc ::tkjabber::get_participant_jid {nick_or_jid} { variable conference jlib::splitjidex $nick_or_jid node domain resource if {$node eq {}} { set tmp $conference/$nick_or_jid if {[is_participant $tmp]} { return $tmp } } return $nick_or_jid } proc ::tkjabber::query_user {user what} { array set q { version "jabber:iq:version" last "jabber:iq:last" time "jabber:iq:time" |
︙ | ︙ | |||
8941 8942 8943 8944 8945 8946 8947 8948 8949 8950 8951 8952 8953 8954 8955 8956 8957 8958 8959 8960 8961 8962 | } return $r } # accept a chatroom nick or a full jid and try and return # the users canonical jid proc ::tkjabber::normalized_jid {jid} { if {[string first @ $jid] == -1} { if {[info exists OnlineUsers(Jabber-$jid,jid)]} { set jid $OnlineUsers(Jabber-$jid,jid) } else { set jid $Options(JabberConference)/$jid } } return $jid } # Send a Jabber message to the full jid of a user. Accept either a full # JID or lookup a chatroom nick in the OnlineUsers array. Such messages # are held for the user if the user is not currently available. proc ::tkjabber::send_memo {to msg {subject Memo}} { global Options | > < < < < < < < < < < | < < | | > | | | 8954 8955 8956 8957 8958 8959 8960 8961 8962 8963 8964 8965 8966 8967 8968 8969 8970 8971 8972 8973 8974 8975 8976 8977 8978 8979 8980 8981 8982 8983 8984 8985 8986 8987 8988 8989 8990 8991 8992 | } return $r } # accept a chatroom nick or a full jid and try and return # the users canonical jid proc ::tkjabber::normalized_jid {jid} { global Options if {[string first @ $jid] == -1} { if {[info exists OnlineUsers(Jabber-$jid,jid)]} { set jid $OnlineUsers(Jabber-$jid,jid) } else { set jid $Options(JabberConference)/$jid } } return $jid } # Send a Jabber message to the full jid of a user. Accept either a full # JID or lookup a chatroom nick in the OnlineUsers array. Such messages # are held for the user if the user is not currently available. proc ::tkjabber::send_memo {to msg {subject Memo}} { global Options variable jabber set to [get_participant_jid $to] lappend x [wrapper::createtag nick -chdata $Options(Nickname) \ -attrlist {xmlns http://jabber.org/protocol/nick}] lappend x [wrapper::createtag x -attrlist [list xmlns urn:tkchat:chat \ color $Options(MyColor)]] $jabber send_message $to -type normal -subject $subject -body $msg \ -xlist $x tkchat::addStatus 0 "Memo sent to $to." } proc ::tkchat::updateOnlineNames {} { global Options variable OnlineUsers |
︙ | ︙ | |||
9305 9306 9307 9308 9309 9310 9311 | variable roster variable jabber variable ::tkchat::OnlineUsers jlib::splitjid $reqfrom ojid ores jlib::splitjid [$jabber myjid] myjid myres | | | 9308 9309 9310 9311 9312 9313 9314 9315 9316 9317 9318 9319 9320 9321 9322 | variable roster variable jabber variable ::tkchat::OnlineUsers jlib::splitjid $reqfrom ojid ores jlib::splitjid [$jabber myjid] myjid myres if {![jlib::jidequal $ojid $myjid]} { # No, it is not a request from an alter ego. # Denied. ::log::log debug "Denied nick transfer request from $reqfrom" return } # It is a valid request. Do the transfer. |
︙ | ︙ | |||
9454 9455 9456 9457 9458 9459 9460 | } } # Respond to subscriptin requests proc tkjabber::SubscriptionRequest {from status} { variable subs_uid if {![info exists subs_uid]} { set subs_uid 0 } | | | 9457 9458 9459 9460 9461 9462 9463 9464 9465 9466 9467 9468 9469 9470 9471 | } } # Respond to subscriptin requests proc tkjabber::SubscriptionRequest {from status} { variable subs_uid if {![info exists subs_uid]} { set subs_uid 0 } jlib::splitjid $from jid res set ttl [msgcat::mc "Subscribe request from %s" $jid] set msg [msgcat::mc "Do you want to let %s add you to their roster?" $jid] set status [string trim $status] set wid dlg[incr subs_uid] set dlg [::tkchat::Dialog .$wid] wm title $dlg $ttl set f [frame $dlg.f -borderwidth 0] |
︙ | ︙ | |||
9480 9481 9482 9483 9484 9485 9486 | pack $lt $ls $lm $fb -side top -fill x -expand 1 pack $f -side top -fill both -expand 1 set [namespace current]::$wid waiting tkwait variable [namespace current]::$wid destroy $dlg set response [set [namespace current]::$wid] $tkjabber::jabber send_presence -type $response \ | | | 9483 9484 9485 9486 9487 9488 9489 9490 9491 9492 9493 9494 9495 9496 9497 | pack $lt $ls $lm $fb -side top -fill x -expand 1 pack $f -side top -fill both -expand 1 set [namespace current]::$wid waiting tkwait variable [namespace current]::$wid destroy $dlg set response [set [namespace current]::$wid] $tkjabber::jabber send_presence -type $response \ -to $from -extras [list [get_caps]] unset [namespace current]::$wid return } proc ::tkjabber::away { status {show away} } { variable conference variable jabber |
︙ | ︙ | |||
9555 9556 9557 9558 9559 9560 9561 | eval [linsert $opts 0 $token send_iq result [list $xmllist]] return 1 ;# handled } proc tkjabber::on_iq_version_result {token from xmllist args} { variable conference array set a [concat -id {{}} $args] | | > < | 9558 9559 9560 9561 9562 9563 9564 9565 9566 9567 9568 9569 9570 9571 9572 9573 9574 | eval [linsert $opts 0 $token send_iq result [list $xmllist]] return 1 ;# handled } proc tkjabber::on_iq_version_result {token from xmllist args} { variable conference array set a [concat -id {{}} $args] jlib::splitjid $from conf nick if {[jlib::jidequal $conf $conference]} { if {[llength [package provide tooltip]] > 0} { array set data {} foreach sub [wrapper::getchildren $xmllist] { set data([wrapper::gettag $sub]) [wrapper::getcdata $sub] } set ver "" if {[info exists data(name)]} { append ver $data(name) } if {[info exists data(version)]} { append ver " " $data(version) } |
︙ | ︙ | |||
9634 9635 9636 9637 9638 9639 9640 | # ------------------------------------------------------------------------- proc ::tkjabber::getChatWidget { jid from } { variable ChatWindows global Options # Look in ChatWindows and maybe popup a new chat window | | | 9637 9638 9639 9640 9641 9642 9643 9644 9645 9646 9647 9648 9649 9650 9651 | # ------------------------------------------------------------------------- proc ::tkjabber::getChatWidget { jid from } { variable ChatWindows global Options # Look in ChatWindows and maybe popup a new chat window jlib::splitjid [jlib::jidprep $jid] jwr res if {![info exists ChatWindows(txt.$jid)] && [info exists ChatWindows(txt.$jwr)] } then { # We have a window for that JID with no resource. # Let's personalise it. foreach v {toplevel title txt} { if {[info exists ChatWindows($v.$jwr)]} { |
︙ | ︙ |