# $Id: tclchat_messages.tcl 1903 2010-01-30 22:12:22Z sergei $
#
# This does the same job and draw_normal_message but is capable of filtering
# the extra nicks generated by the various bridges used in the tclers chats.
# Namely ircbridge and ijbridge.
#
# This plugin processes messages from ijbridge in Tclers' chat only
# (tcl@tach.tclers.tk)
#
# Includes support for nick_colors.tcl (now incorporated into tkabber proper)
# and also supports the tclers chat embedded color.
#
# Originally by Steve Redler.
# Modified by Pat Thoyts.
# Rewritten by Sergei Golovan

namespace eval tclchat {
    custom::defvar options(tclers_chat_jid) "tcl@tach.tclers.tk" \
        [::msgcat::mc "JID of Tclers' chat."] \
        -group Tclchat -type string
    
    custom::defvar options(bridge_jid) "ijchain@all.tclers.tk/ijbridge" \
        [::msgcat::mc "Real JID of Tclers' chat bridge to IRC channel.\
		       If set to nonempty string, the list of IRC users\
		       will be requested before entering the conference room."] \
        -group Tclchat -type string
    
    custom::defvar options(bridge_nickname) "ijchain" \
        [::msgcat::mc "Nickname of Tclers' chat bridge to IRC channel.\
		       Groupchat messages from this participant\
		       are treated specially, replacing his nickname by\
		       corresponding IRC user nickname."] \
        -group Tclchat -type string
}

proc tclchat::load_messages {} {
    hook::add presence_xlist_hook  [namespace current]::request_users_list
    hook::add process_message_hook [namespace current]::fill_irc_users 30
    hook::add process_message_hook [namespace current]::process_ijchain_message 30
    hook::add draw_message_hook    [namespace current]::check_color 62
    hook::add join_group_hook      [namespace current]::touch_connect
}

proc tclchat::unload_messages {} {
    hook::remove presence_xlist_hook  [namespace current]::request_users_list
    hook::remove process_message_hook [namespace current]::fill_irc_users 30
    hook::remove process_message_hook [namespace current]::process_ijchain_message 30
    hook::remove draw_message_hook    [namespace current]::check_color 62
    hook::remove join_group_hook      [namespace current]::touch_connect
}

# VERY DIRTY HACK. Tkabber doesn't have appropriate hook, so using inappropriate
proc tclchat::request_users_list {vxlist xlib stat} {
    upvar 3 group group
    variable irc_users
    variable options

    # HACK: Use the fact that joining groupchat calls presence_args
    # which in turn runs presence_xlist_hook
    if {![info exists group]} return

    # Don't request IRC users list if bridge JID is empty
    if {[cequal $options(bridge_jid) ""]} return

    # If the presence doesn't go to Tclers' chat, do nothing
    if {![cequal $group $options(tclers_chat_jid)]} return

    set chatid [chat::chatid $xlib $group]

    # If the chat is disconnected then we're trying to connect. Then it's
    # time to request IRC users list
    if {[chat::is_opened $chatid] && [chat::is_disconnected $chatid]} {
	# Setting the flag to show that the answer is to be processed
	# programmatically
	set irc_users($xlib) {}
	message::send_msg $xlib $options(bridge_jid) \
			  -type chat \
			  -body names
    }
}

proc tclchat::fill_irc_users \
     {xlib from id type is_subject subject body err thread priority x} {
    variable irc_users
    variable options

    # Don't process message if we didn't ask the list or this message isn't
    # from bridge JID
    if {![info exists irc_users($xlib)]} return
    if {![cequal $from $options(bridge_jid)]} return

    unset irc_users($xlib)
    after idle [list [namespace current]::inject_irc_users $xlib $body]
    return stop
}

proc tclchat::touch_connect {chatid nick} {
    variable connect

    set connect($chatid) {}
}

proc tclchat::update_presence {xlib jid type xmlElements} {
    client:presence $xlib $jid $type $xmlElements
    ::xmpp::presence::process $xlib $jid $type $xmlElements
}

proc tclchat::inject_irc_users {xlib users args} {
    variable irc_users
    variable connect
    variable options

    set group $options(tclers_chat_jid)

    set chatid [chat::chatid $xlib $group]

    trace vdelete [namespace current]::connect($chatid) w \
	  [list [namespace current]::inject_irc_users $xlib $users]

    if {![chat::is_opened $chatid]} {
	catch {unset connect($chatid)}
	return
    }

    # If we're still disconnected, schedule the IRC users injection after
    # a change in chat status
    if {![info exists connect($chatid)]} {
	trace variable [namespace current]::connect($chatid) w \
	      [list [namespace current]::inject_irc_users $xlib $users]
	return
    }

    unset connect($chatid)

    set px [::xmpp::xml::create x \
		-xmlns $::NS(muc#user) \
		-subelement [::xmpp::xml::create item \
				    -attrs [list affiliation none]]]
    foreach nick $users {
	set nickid $group/$nick
	if {![jid_in_chat $chatid $nickid]} {
	    update_presence $xlib $nickid available [list $px]
	} else {
	    client:message $xlib $group groupchat {} \
			   -body [::msgcat::mc "%s has joined IRC channel,\
						but he/she is already in\
						Jabber room" $nick]
	}
    }
}

###############################################################################

proc tclchat::jid_in_chat {chatid jid} {
    set xlib [chat::get_xlib $chatid]
    set nick [::xmpp::jid::resource $jid]
    expr {[lsearch -exact [muc::roster $chatid] $nick] >= 0 && \
		![cequal [muc::get_role $xlib $jid] ""]}
}

proc tclchat::process_ijchain_message \
     {xlib from id type is_subject subject body err thread priority x} {
    variable options

    # Filter groupchat messages only
    if {![cequal $type groupchat]} return

    set group [::xmpp::jid::stripResource $from]

    set chatid [chat::chatid $xlib $group]

    # Filter messages from tcl@tach.tclers.tk only
    if {![cequal $group $options(tclers_chat_jid)]} return

    set nick [chat::get_nick $xlib $from $type]

    # Filter messages from ijchain only
    if {$nick != $options(bridge_nickname)} return

    set lbody [split $body " "]
    # Update userlist on "*** nick leaves" and "*** nick joins" messages
    # Update userlist on "* nick left" and "* nick entered" messages
    if {[llength $lbody] == 3 && [cequal [lindex $lbody 0] "***"]} {

	set nick [lindex $lbody 1]
	set nickid $group/$nick

	switch -- [lindex $lbody 2] {
	    joins {
		debugmsg chat "Handle \"$nick\" joined message."

		set px [::xmpp::xml::create x \
			    -xmlns $::NS(muc#user) \
			    -subelement [::xmpp::xml::create item \
						-attrs [list affiliation none]]]

		if {![jid_in_chat $chatid $nickid]} {
		    update_presence $xlib $nickid available [list $px]
		} else {
		    client:message $xlib $group $type {} \
				   -body [::msgcat::mc "%s has joined IRC\
							channel, but %s is\
							already in Jabber room" \
						       $nick $nick]
		}
	    }
	    leaves {
		debugmsg chat "Handle \"$nick\" left message."

		if {![jid_in_chat $chatid $nickid]} {
		    update_presence $xlib $nickid unavailable {}
		} else {
		    client:message $xlib $group $type {} \
				   -body [::msgcat::mc "%s has left IRC\
							channel, but %s is\
							still in Jabber room" \
						       $nick $nick]
		}
	    }
	    default {
		return
	    }
	}

	return stop
    }

    if {[llength $lbody] == 7 && [cequal [lindex $lbody 0] "***"]} {

	set from_nick [lindex $lbody 1]
	set to_nick [lindex $lbody 6]

	if {[cequal [join [lrange $lbody 2 5] " "] "is now known as"]} {
	    
	    set ux [::xmpp::xml::create x \
			-xmlns $::NS(muc#user) \
			-subelement [::xmpp::xml::create item \
					    -attrs [list affiliation none \
							 nick $to_nick]] \
			-subelement [::xmpp::xml::create status \
					    -attrs [list code 303]]]

	    set px [::xmpp::xml::create x \
			-xmlns $::NS(muc#user) \
			-subelement [::xmpp::xml::create item \
					    -attrs [list affiliation none]]]

	    set from_nickid $group/$from_nick
	    set to_nickid $group/$to_nick

	    if {![jid_in_chat $chatid $from_nickid]} {
		if {![jid_in_chat $chatid $to_nickid]} {
		    update_presence $xlib $from_nickid unavailable [list $ux]
		    update_presence $xlib $to_nickid available [list $px]
		} else {
		    update_presence $xlib $from_nickid unavailable {}
		    client:message $xlib $group $type {} \
				   -body [::msgcat::mc "%s has changed nick\
							to %s in the IRC channel,\
							but %s is already in\
							Jabber room" \
						 $from_nick $to_nick $to_nick]
		}
	    } else {
		if {![jid_in_chat $chatid $to_nickid]} {
		    client:message $xlib $group $type {} \
				   -body [::msgcat::mc "%s has changed nick to\
							%s in the IRC channel,\
							but %s is still in Jabber\
							room" \
						 $from_nick $to_nick $from_nick]
		    update_presence $xlib $to_nickid available [list $px]
		} else {
		    client:message $xlib $group $type {} \
				   -body [::msgcat::mc "%s has changed nick to %s\
							in the IRC channel,\
							but %s is still in Jabber\
							room and %s is already in\
							Jabber room" \
						 $from_nick $to_nick $from_nick $to_nick]
		}
	    }
	    return stop
	}

	return
    }

    # Filter out nicks
    if {[regexp {^<(\S+)>\s+(.*)} $body -> nick body]} {
	set nickid $group/$nick
	client:message $xlib $nickid $type {} -body $body
	return stop
    } elseif {[regexp {^\*\s+(\S+)\s+(.*)} $body -> nick body]} {
	set nickid $group/$nick
	client:message $xlib $nickid $type {} -body "/me $body"
	return stop
    }

    return
}

# TODO: Use of tkchat colors
# tclchat::check_color --
#
#	The tclers chat client 'tkchat' likes to embed the users choice of
#	color into the 'x' elements of each jabber message. In this procedure
#	we check that our idea of their color agrees. If not we'll update
#	and refresh.
#
proc tclchat::check_color {chatid from type body x} {
    set xlib [chat::get_xlib $chatid]
    set nick [chat::get_nick $xlib $from $type]
    foreach node $x {
        ::xmpp::xml::split $node tag xmlns attrs cdata subels
        if {$xmlns == "urn:tkchat:chat"} {
            set color [string trim [::xmpp::xml::getAttr $attrs "color"] "#"]
            if {[string length $color] > 0} {
                set orig [::plugins::nickcolors::get_color $nick]
                debugmsg chat "Checking color for $nick ('$orig' eq '#$color')"
                if {"$orig" != "#$color"} {
                    ::plugins::nickcolors::set_color $chatid $nick "#$color"
                }
            }
        }
    }
}

# vim:ts=8:sw=4:sts=4:noet
