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.

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.

    }
}

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.463 2009/04/09 00:37:47 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." \
................................................................................
    $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?
	if {[regexp {([^/]+)/(.+)} $jid -> conf nick]
	    && $conf eq $Options(JabberConference)
	} then {
	    lappend nicks $nick
	}
    }
    foreach nk $nicks {
	set nk [lindex $nk 0]
	set clr [getColor $nk]
        if {[catch {$txt tag configure NICK-$nk -foreground "#$clr"}]} {
................................................................................
	}
    }

    switch -- $type {
	chat {
	    set from $m(-from)
	    set w .txt
	    if { [regexp {([^/]+)/(.+)} $m(-from) -> conf from] } {
		if { $conf eq $conference } {

		    set w [getChatWidget $m(-from) $from]
		} else {
		    regexp {^([^@]+)@} $m(-from) -> from
		    set w [getChatWidget $m(-from) $from]
		}
	    } else {
		regexp {^([^@]+)@} $m(-from) -> from
		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 {
................................................................................
                    }
		}
		::tkchat::addMessage \
			$w $color $from $m(-body) $msgtype end $timestamp
	    }
	}
	groupchat {
	    set from $m(-from)
	    regexp {([^/]+)/(.+)} $m(-from) -> conf from
	    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 { $from eq $conference } {
			::tkchat::addSystem .txt $m(-body)
		    } else {
			append msg "\n ... $m(-body)"
			::tkchat::addMessage \
				.txt $color $from $msg ACTION end $timestamp
		    }
		} else {
		    ::tkchat::addMessage .txt \
			    $color $from $msg ACTION end $timestamp
		}
	    } else {
		if { [info exists m(-body)] && $m(-body) ne ""} {
		    parseMsg $from $m(-body) $color end $timestamp
		} else {
		    ::log::log notice "Unknown message from $from: '$args'"
		}
	    }
	}
	normal {
	    set from $m(-from)
            set conf [jid !resource $m(-from)]
            if {$conf eq $conference } {
		set from [jid resource $m(-from)]
	    }
	    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 ""
................................................................................
	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] {
	    regexp {([^/])/(.+)} $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
                }
................................................................................
    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}]

}















proc ::tkjabber::get_participant_jid {user} {
    variable conference
    if {[string first @ $user] == -1} {




        return ${conference}/$user
    }

    return $user
}

proc ::tkjabber::query_user {user what} {
    array set q {
        version  "jabber:iq:version"
        last     "jabber:iq:last"
        time     "jabber:iq:time"
................................................................................
    }
    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
	}
    }
................................................................................
}

# 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 myId
    variable jabber
    variable ::tkchat::OnlineUsers

    if {[string first @ $to] == -1} {
	if {[info exists OnlineUsers(Jabber-$to,jid)]} {
	    set to $OnlineUsers(Jabber-$to,jid)
	} else {
	    tkchat::addStatus 0 "Cannot find a JID for '$to'."
	    return
	}
    }

    set k {}
    lappend k [wrapper::createtag subject -chdata $subject]

    lappend k [wrapper::createtag nick -chdata $Options(Nickname) \
                   -attrlist {xmlns http://jabber.org/protocol/nick}]
    lappend k [wrapper::createtag body -chdata $msg]
    $jabber send [wrapper::createtag message -subtags $k \
                      -attrlist [list type normal to $to]]




    tkchat::addStatus 0 "Memo sent to $to."
}

proc ::tkchat::updateOnlineNames {} {
    global Options
    variable OnlineUsers

................................................................................
    variable roster
    variable jabber
    variable ::tkchat::OnlineUsers

    jlib::splitjid $reqfrom ojid ores
    jlib::splitjid [$jabber myjid] myjid myres

    if { $ojid ne $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.
................................................................................
    }
}

# Respond to subscriptin requests
proc tkjabber::SubscriptionRequest {from status} {
    variable subs_uid
    if {![info exists subs_uid]} { set subs_uid 0 }
    set jid [jid !resource $from]
    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]
................................................................................
    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 $jid -extras [list [get_caps]]
    unset [namespace current]::$wid
    return
}

proc ::tkjabber::away { status {show away} } {
    variable conference
    variable jabber
................................................................................
    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]
    if {[jid !resource $from] eq $conference} {

        if {[llength [package provide tooltip]] > 0} {
            set nick [jid resource $from]
            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) }
................................................................................
# -------------------------------------------------------------------------

proc ::tkjabber::getChatWidget { jid from } {
    variable ChatWindows
    global Options
    # Look in ChatWindows and maybe popup a new chat window

    set jwr [jid !resource $jid]
    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)]} {

    }
}

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." \
................................................................................
    $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"}]} {
................................................................................
	}
    }

    switch -- $type {
	chat {
	    set from $m(-from)
	    set w .txt
            jlib::splitjidex $m(-from) node domain resource
            if {[jlib::jidequal [email protected]$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 {
................................................................................
                    }
		}
		::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 ""
................................................................................
	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
                }
................................................................................
    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"
................................................................................
    }
    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
	}
    }
................................................................................
}

# 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

................................................................................
    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.
................................................................................
    }
}

# 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]
................................................................................
    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
................................................................................
    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) }
................................................................................
# -------------------------------------------------------------------------

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)]} {