# $Id: tclchat_messages.tcl 1320 2007-11-25 11:23:37Z 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
    
    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
}

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

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

    # HACK: Extract conference name from directed presence. If it isn't
    # a directed presence then do nothing
    array set tmp $args
    if {![info exists tmp(-to)]} return

    set to $tmp(-to)
    set group [node_and_server_from_jid $to]

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

    set chatid [chat::chatid $connid $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_groupchat $chatid] && \
	    $chat::chats(status,$chatid) == "disconnected"} {
	# Setting the flag to show that the answer is to be processed
	# programmatically
	set irc_users($connid) {}
	message::send_msg $options(bridge_jid) \
			  -type chat \
			  -body names \
			  -connection $connid
    }
}

proc tclchat::fill_irc_users \
     {connid 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($connid)]} return
    if {![cequal $from $options(bridge_jid)]} return

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

proc tclchat::inject_irc_users {connid users args} {
    variable options

    set group $options(tclers_chat_jid)

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

    trace vdelete chat::chats(status,$chatid) w \
	  [list [namespace current]::inject_irc_users $connid $users]

    if {![chat::is_opened $chatid]} return

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

    set px [jlib::wrapper:createtag x \
		-vars [list xmlns $::NS(muc#user)] \
		-subtags [list [jlib::wrapper:createtag item \
				    -vars [list affiliation none]]]]
    foreach nick $users {
	set nickid $group/$nick
	if {[lsearch -exact $::grouproster(users,$chatid) $nickid] < 0 || \
		[cequal $::muc::users(role,$connid,$nickid) ""]} {
	    client:presence $connid $nickid available [list $px]
	} else {
	    client:message $connid $group "" groupchat 0 "" \
			   [::msgcat::mc "%s has joined IRC channel,\
					  but he/she is already in Jabber room" \
					 $nick] [list "" ""] "" "" {}
	}
    }
}

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

proc tclchat::jid_in_chat {chatid jid} {
    set connid [chat::get_connid $chatid]
    return [expr {[lsearch -exact $::grouproster(users,$chatid) $jid] >= 0 && \
		  ![cequal $::muc::users(role,$connid,$jid) ""]}]
}

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

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

    set group [node_and_server_from_jid $from]

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

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

    set nick [chat::get_nick $connid $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 [jlib::wrapper:createtag x \
			    -vars [list xmlns $::NS(muc#user)] \
			    -subtags [list [jlib::wrapper:createtag item \
						-vars [list affiliation none]]]]

		if {![jid_in_chat $chatid $nickid]} {
		    client:presence $connid $nickid available [list $px]
		} else {
		    client:message $connid $group $id $type 0 "" \
				   [::msgcat::mc "%s has joined IRC channel,\
						  but %s is already in Jabber room" \
						 $nick $nick] \
				   $err $thread $priority $x
		}
	    }
	    leaves {
		debugmsg chat "Handle \"$nick\" left message."

		if {![jid_in_chat $chatid $nickid]} {
		    client:presence $connid $nickid unavailable {}
		} else {
		    client:message $connid $group $id $type 0 "" \
				   [::msgcat::mc "%s has left IRC channel,\
						  but %s is still in Jabber room" \
						 $nick $nick] \
				   $err $thread $priority $x
		}
	    }
	    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 [jlib::wrapper:createtag x \
			-vars [list xmlns $::NS(muc#user)] \
			-subtags [list [jlib::wrapper:createtag item \
					    -vars [list affiliation none \
							nick $to_nick]] \
				       [jlib::wrapper:createtag status \
					    -vars [list code 303]]]]

	    set px [jlib::wrapper:createtag x \
			-vars [list xmlns $::NS(muc#user)] \
			-subtags [list [jlib::wrapper:createtag item \
					    -vars [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]} {
		    client:presence $connid $from_nickid unavailable [list $ux]
		    client:presence $connid $to_nickid available [list $px]
		} else {
		    client:presence $connid $from_nickid unavailable {}
		    client:message $connid $group $id $type 0 "" \
				   [::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] \
				   $err $thread $priority $x
		}
	    } else {
		if {![jid_in_chat $chatid $to_nickid]} {
		    client:message $connid $group $id $type 0 "" \
				   [::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] \
				   $err $thread $priority $x
		    client:presence $connid $to_nickid available [list $px]
		} else {
		    client:message $connid $group $id $type 0 "" \
				   [::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] \
				   $err $thread $priority $x
		}
	    }
	    return stop
	}

	return
    }

    # Filter out nicks
    if {[regexp {^<(\S+)>\s+(.*)} $body -> nick body]} {
	set nickid $group/$nick
	client:message $connid $nickid $id $type $is_subject $subject $body \
		       $err $thread $priority $x
	return stop
    } elseif {[regexp {^\*\s+(\S+)\s+(.*)} $body -> nick body]} {
	set nickid $group/$nick
	client:message $connid $nickid $id $type $is_subject $subject "/me $body" \
		       $err $thread $priority $x
	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 connid [chat::get_connid $chatid]
    set nick [chat::get_nick $connid $from $type]
    foreach node $x {
        jlib::wrapper:splitxml $node tag attr isempty body children
        if {[jlib::wrapper:getattr $attr xmlns] == "urn:tkchat:chat"} {
            set color [string trim [jlib::wrapper:getattr $attr "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
