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

    }
}

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 attrs [concat $opts(-attrs) \
		   [list xmlns urn:tkchat:chat color $::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}
            }