Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | removed misguided xml quoting from nicks and fixed a bug that prevented sending to a backslashed nick. |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
b6d9df09079433074f6d749d79b2ea2a |
| User & Date: | patthoyts 2009-04-23 00:54:35 |
Context
|
2009-05-13
| ||
| 12:02 | Support detection of suspend/resume. Added a muc join hook, ignore empty messages with chatstate notifications in chat windows. Some themeing on the colour dialog. check-in: 59d2cae22c user: patthoyts tags: trunk | |
|
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 | |
Changes
Changes to apps/tkchat/ChangeLog.
1 2 3 4 5 6 7 8 9 |
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 |
> > |
1 2 3 4 5 6 7 8 9 10 11 |
2009-04-23 Pat Thoyts <[email protected]> * tkchat.tcl: removed misguided xml quoting from nicks and fixed a bug that prevented sending to a backslashed nick. * 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 |
Changes to apps/tkchat/tkchat.tcl.
254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 .... 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 .... 6233 6234 6235 6236 6237 6238 6239 6240 6241 6242 6243 6244 6245 6246 .... 8280 8281 8282 8283 8284 8285 8286 8287 8288 8289 8290 8291 8292 8293 8294 8295 .... 8574 8575 8576 8577 8578 8579 8580 8581 8582 8583 8584 8585 8586 8587 8588 .... 8643 8644 8645 8646 8647 8648 8649 8650 8651 8652 8653 8654 8655 8656 8657 .... 8676 8677 8678 8679 8680 8681 8682 8683 8684 8685 8686 8687 8688 8689 8690 .... 8829 8830 8831 8832 8833 8834 8835 8836 8837 8838 8839 8840 8841 8842 8843 .... 8847 8848 8849 8850 8851 8852 8853 8854 8855 8856 8857 8858 8859 8860 8861 8862 .... 9260 9261 9262 9263 9264 9265 9266 9267 9268 9269 9270 9271 9272 9273 9274 9275 9276 .... 9295 9296 9297 9298 9299 9300 9301 9302 9303 9304 9305 9306 9307 9308 9309 .... 9332 9333 9334 9335 9336 9337 9338 9339 9340 9341 9342 9343 9344 9345 9346 ..... 10000 10001 10002 10003 10004 10005 10006 10007 10008 10009 10010 10011 10012 10013 10014 |
}
}
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." \
................................................................................
focus -force .logon.ok
grab .logon
vwait ::tkchat::DlgDone
grab release .logon
wm withdraw .logon
if { $DlgDone eq "ok" } {
unset -nocomplain Options(ProxyAuth)
# connect
logonChat
}
}
proc ::tkchat::IRCLogonScreen {} {
................................................................................
return [array get Defaults]
}
proc ::tkchat::setNickname { nick } {
global Options
variable ::tkjabber::baseNick
if { ![info exist Options(Color,NICK-$nick)] } {
if { [info exists Options(Color,NICK-$baseNick)] } {
set Options(Color,NICK-$nick) $Options(Color,NICK-$baseNick)
} else {
set Options(Color,NICK-$nick) $Options(Color,MainFG)
}
}
................................................................................
}] } {
::log::log debug "MUC EXIT: $::errorInfo"
}
set msg [lindex $m(-error) 1]
::tkchat::addSystem .txt \
"$m(-from): $msg. Trying to get in again..."
$muc enter $::tkjabber::conference \
[xmlSafe $::Options(Nickname)] \
-command ::tkjabber::MucEnterCB
}
default {
::tkchat::addSystem .txt "MsgCB (error) args='$args'"
}
}
}
}
................................................................................
if { $::Options(Nickname) eq "" } {
::tkchat::setNickname $::Options(Username)
}
set baseNick $::Options(Nickname)
set nickTries 0
if {[string length $conference] > 0} {
after idle [list $muc enter $conference \
[xmlSafe $::Options(Nickname)] \
-command ::tkjabber::MucEnterCB]
}
::tkchat::SetServerTooltip
# We are logged in. Now any of the callbacks can be called,
# Likely ones are MsgCB, MucEnterCB, RosterCB for normal traffic.
::tkchat::Hook run login
................................................................................
}
404 - "item-not-found" {
if {$mucTries < 3} {
::tkchat::addSystem .txt "This room is unavailable.\
Retrying in 30 seconds..."
incr mucTries
after 10000 [list $muc enter $conference \
[xmlSafe $::Options(Nickname)] \
-command ::tkjabber::MucEnterCB]
} else {
::tkchat::addSystem .txt "This room does not exist."
}
}
405 - "service-unavailable" {
::tkchat::addSystem .txt [concat \
................................................................................
if { $nickTries < 3 } {
::tkchat::setNickname "$::Options(Nickname)_"
} else {
::tkchat::setNickname "${baseNick}_$nickTries"
}
::tkchat::addSystem .txt \
"Trying to enter using $::Options(Nickname)."
$muc enter $conference [xmlSafe $::Options(Nickname)] \
-command ::tkjabber::MucEnterCB
}
}
default {
::tkchat::addSystem .txt \
"An error occurred joining $conference.\
Unfortunately '[lindex $m(-error) 0]' was not\
................................................................................
}
if { !$found } {
::tkchat::addStatus 0 "Unknown nick name '$user'"
return
}
}
if { [llength $users] == 0 } {
set users $user
}
# Example usage
#set x [wrapper::createtag x -attrlist {xmlns urn:tkchat:chat} \
# -subtags [list [wrapper::createtag color \
# -attrlist {attr1 val1 attr2 val2} \
# -chdata $::Options(MyColor)]]]
................................................................................
set xlist [concat [list [wrapper::createtag x -attrlist $attrs]] \
$opts(-xlist)]
::log::log debug "send_message $msg $xlist"
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] {
................................................................................
variable conference
variable roster
variable jabber
variable grabNick
variable baseNick
variable ::tkchat::OnlineUsers
if { [lsearch -exact $OnlineUsers(Jabber) $newnick] > -1 } {
# Perhaps it is my own nick, in another window?
set x [$roster getx $conference/[xmlSafe $newnick] "muc#user"]
set item [wrapper::getchildswithtag $x item]
set otherjid ""
if {[llength $item] > 0} {
set otherjid [wrapper::getattribute [lindex $item 0] jid]
}
jlib::splitjid [$jabber myjid] myjid myres
................................................................................
return
}
# There is a race condition here. new nick could enter between the check
# and the setnick call...
::tkchat::setNickname $newnick
set baseNick $newnick
$muc setnick $conference [xmlSafe $newnick]
}
proc ::tkjabber::transferNick { reqfrom } {
variable muc
variable conference
variable roster
variable jabber
................................................................................
::tkchat::addStatus 0 \
"Got a nick transfer request, but $newnick is already in use."
return
}
# Set my nick name to newnick.
::tkchat::setNickname $newnick
$muc setnick $conference [xmlSafe $newnick]
# The other party does not need to be notified
# - it should be in nickgrab mode.
}
proc ::tkjabber::setTopic { newtopic } {
variable conference
................................................................................
}
proc ::tkjabber::LogPrivateChat {user spkr ztime message} {
global Options env
if {![info exist env(HOME)]} { return }
if {[info exists Options(LogPrivateChat)] && $Options(LogPrivateChat)} {
variable PrivateChatLogs
set user [string map {/ _ \\ _ : _ . _} $user]
if {![info exists PrivateChatLogs]} { array set PrivateChatLogs {} }
if {![info exists PrivateChatLogs($user)]} {
set dir [file join $env(HOME) .tkchat_logs]
if {![file isdirectory $dir]} {
file mkdir $dir
catch {file attributes $dir -hidden 1}
}
|
| > > | | | | | | < < > | | | | |
254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 .... 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 .... 6234 6235 6236 6237 6238 6239 6240 6241 6242 6243 6244 6245 6246 6247 6248 .... 8282 8283 8284 8285 8286 8287 8288 8289 8290 8291 8292 8293 8294 8295 8296 8297 .... 8576 8577 8578 8579 8580 8581 8582 8583 8584 8585 8586 8587 8588 8589 8590 .... 8645 8646 8647 8648 8649 8650 8651 8652 8653 8654 8655 8656 8657 8658 8659 .... 8678 8679 8680 8681 8682 8683 8684 8685 8686 8687 8688 8689 8690 8691 8692 .... 8831 8832 8833 8834 8835 8836 8837 8838 8839 8840 8841 8842 8843 8844 8845 .... 8849 8850 8851 8852 8853 8854 8855 8856 8857 8858 8859 8860 8861 8862 .... 9260 9261 9262 9263 9264 9265 9266 9267 9268 9269 9270 9271 9272 9273 9274 9275 9276 9277 .... 9296 9297 9298 9299 9300 9301 9302 9303 9304 9305 9306 9307 9308 9309 9310 .... 9333 9334 9335 9336 9337 9338 9339 9340 9341 9342 9343 9344 9345 9346 9347 ..... 10001 10002 10003 10004 10005 10006 10007 10008 10009 10010 10011 10012 10013 10014 10015 |
}
}
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.465 2009/04/23 00:54:35 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." \
................................................................................
focus -force .logon.ok
grab .logon
vwait ::tkchat::DlgDone
grab release .logon
wm withdraw .logon
if { $DlgDone eq "ok" } {
unset -nocomplain Options(ProxyAuth)
set Options(Nickname) [jlib::resourceprep $Options(Nickname)]
# connect
logonChat
}
}
proc ::tkchat::IRCLogonScreen {} {
................................................................................
return [array get Defaults]
}
proc ::tkchat::setNickname { nick } {
global Options
variable ::tkjabber::baseNick
set nick [jlib::resourceprep $nick]
if { ![info exist Options(Color,NICK-$nick)] } {
if { [info exists Options(Color,NICK-$baseNick)] } {
set Options(Color,NICK-$nick) $Options(Color,NICK-$baseNick)
} else {
set Options(Color,NICK-$nick) $Options(Color,MainFG)
}
}
................................................................................
}] } {
::log::log debug "MUC EXIT: $::errorInfo"
}
set msg [lindex $m(-error) 1]
::tkchat::addSystem .txt \
"$m(-from): $msg. Trying to get in again..."
$muc enter $::tkjabber::conference \
$::Options(Nickname)\
-command ::tkjabbjler::MucEnterCB
}
default {
::tkchat::addSystem .txt "MsgCB (error) args='$args'"
}
}
}
}
................................................................................
if { $::Options(Nickname) eq "" } {
::tkchat::setNickname $::Options(Username)
}
set baseNick $::Options(Nickname)
set nickTries 0
if {[string length $conference] > 0} {
after idle [list $muc enter $conference \
$::Options(Nickname) \
-command ::tkjabber::MucEnterCB]
}
::tkchat::SetServerTooltip
# We are logged in. Now any of the callbacks can be called,
# Likely ones are MsgCB, MucEnterCB, RosterCB for normal traffic.
::tkchat::Hook run login
................................................................................
}
404 - "item-not-found" {
if {$mucTries < 3} {
::tkchat::addSystem .txt "This room is unavailable.\
Retrying in 30 seconds..."
incr mucTries
after 10000 [list $muc enter $conference \
$::Options(Nickname) \
-command ::tkjabber::MucEnterCB]
} else {
::tkchat::addSystem .txt "This room does not exist."
}
}
405 - "service-unavailable" {
::tkchat::addSystem .txt [concat \
................................................................................
if { $nickTries < 3 } {
::tkchat::setNickname "$::Options(Nickname)_"
} else {
::tkchat::setNickname "${baseNick}_$nickTries"
}
::tkchat::addSystem .txt \
"Trying to enter using $::Options(Nickname)."
$muc enter $conference $::Options(Nickname) \
-command ::tkjabber::MucEnterCB
}
}
default {
::tkchat::addSystem .txt \
"An error occurred joining $conference.\
Unfortunately '[lindex $m(-error) 0]' was not\
................................................................................
}
if { !$found } {
::tkchat::addStatus 0 "Unknown nick name '$user'"
return
}
}
if { [llength $users] == 0 } {
set users [list $user]
}
# Example usage
#set x [wrapper::createtag x -attrlist {xmlns urn:tkchat:chat} \
# -subtags [list [wrapper::createtag color \
# -attrlist {attr1 val1 attr2 val2} \
# -chdata $::Options(MyColor)]]]
................................................................................
set xlist [concat [list [wrapper::createtag x -attrlist $attrs]] \
$opts(-xlist)]
::log::log debug "send_message $msg $xlist"
foreach user $users {
$jabber send_message $user -body $msg -type $type -xlist $xlist
}
}
# 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] {
................................................................................
variable conference
variable roster
variable jabber
variable grabNick
variable baseNick
variable ::tkchat::OnlineUsers
set newnick [jlib::resourceprep $newnick]
if { [lsearch -exact $OnlineUsers(Jabber) $newnick] > -1 } {
# Perhaps it is my own nick, in another window?
set x [$roster getx $conference/$newnick "muc#user"]
set item [wrapper::getchildswithtag $x item]
set otherjid ""
if {[llength $item] > 0} {
set otherjid [wrapper::getattribute [lindex $item 0] jid]
}
jlib::splitjid [$jabber myjid] myjid myres
................................................................................
return
}
# There is a race condition here. new nick could enter between the check
# and the setnick call...
::tkchat::setNickname $newnick
set baseNick $newnick
$muc setnick $conference $newnick
}
proc ::tkjabber::transferNick { reqfrom } {
variable muc
variable conference
variable roster
variable jabber
................................................................................
::tkchat::addStatus 0 \
"Got a nick transfer request, but $newnick is already in use."
return
}
# Set my nick name to newnick.
::tkchat::setNickname $newnick
$muc setnick $conference $newnick
# The other party does not need to be notified
# - it should be in nickgrab mode.
}
proc ::tkjabber::setTopic { newtopic } {
variable conference
................................................................................
}
proc ::tkjabber::LogPrivateChat {user spkr ztime message} {
global Options env
if {![info exist env(HOME)]} { return }
if {[info exists Options(LogPrivateChat)] && $Options(LogPrivateChat)} {
variable PrivateChatLogs
set user [string map {/ _ \\ _ : _ . _ < _ > _} $user]
if {![info exists PrivateChatLogs]} { array set PrivateChatLogs {} }
if {![info exists PrivateChatLogs($user)]} {
set dir [file join $env(HOME) .tkchat_logs]
if {![file isdirectory $dir]} {
file mkdir $dir
catch {file attributes $dir -hidden 1}
}
|