# tclchat_messages.tcl --
#
#       This file is a part of implementation of Tkabber's interface to
#       the Tcler's chat. It 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 {$options(bridge_jid) eq ""} return

    # If the presence doesn't go to Tclers' chat, do nothing
    if {$group ne $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 {$from ne $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 && \
                [muc::get_role $xlib $jid] ne ""}
}

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

    # Filter groupchat messages only
    if {$type ne "groupchat"} return

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

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

    # Filter messages from tcl@tach.tclers.tk only
    if {$group ne $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 && [lindex $lbody 0] eq "***"} {

        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 && [lindex $lbody 0] eq "***"} {

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

        if {[join [lrange $lbody 2 5] " "] eq "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:et
