# receipts.tcl --
#
#       Support for XEP-0184 "Message Receipts" (v1.1 and 1.0).
#
# Author: Konstantin Khomoutov <flatworm@users.sourceforge.net>
# Artwork by Artem Bannikov <bannikov.artyom at gmail dot com>
#
# See license.terms for legal details on usage and distribution.
# See README for usage guidelines.

package require msgcat

namespace eval receipts {
    ::msgcat::mcload [file join [file dirname [info script]] msgs]

    if {![::plugins::is_registered receipts]} {
        ::plugins::register receipts \
                            -namespace [namespace current] \
                            -source [info script] \
                            -description [::msgcat::mc \
                                            "Whether the Message Receipts\
                                             plugin is loaded."] \
                            -loadcommand \
                                    [namespace code \
                                               [list load \
                                                     [file dirname \
                                                           [info script]]]] \
                            -unloadcommand [namespace code unload]
        return
    }

    variable options

    custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber

    custom::defgroup "Message Receipts" \
        [::msgcat::mc "Request receipts for outgoing\
            messages and reply to such requests originating from chat peers.\
            Message reception state is displayed next to each chat message\
            using special icon."] \
        -group Plugins \
        -group Chat
    custom::defvar options(request) 1 \
        [::msgcat::mc "Request receipts for outgoing messages."] \
        -group "Message Receipts" \
        -type boolean
    custom::defvar options(reply) 1 \
        [::msgcat::mc "Issue receipts for incoming messages."] \
        -group "Message Receipts" \
        -type boolean
}

proc receipts::load {dir} {
    set ::NS(receipts) urn:xmpp:receipts

    foreach item {confirmed unconfirmed} {
        create_image receipts/$item \
              -file [file join $dir images $item.gif]
    }

    hook::add process_message_hook \
              [namespace current]::process_message
    hook::add chat_send_message_xlist_hook \
              [namespace current]::attach_confirmation_request
    hook::add draw_message_hook \
              [namespace current]::add_receipt_icon 7

    disco::register_feature $::NS(receipts)
}

proc receipts::unload {} {
    disco::register_feature $::NS(receipts)

    foreach item {confirmed unconfirmed} {
        image delete photo receipts/$item
    }

    hook::remove process_message_hook \
                 [namespace current]::process_message
    hook::remove chat_send_message_xlist_hook \
                 [namespace current]::attach_confirmation_request
    hook::remove draw_message_hook \
                 [namespace current]::add_receipt_icon 7

    unset ::NS(receipts)
}

# Receipts are only sent when all these conditions hold:
# * They aren't disabled via Customize options.
# * Receipt request is attached to a groupchat private
#   message or to a message from a user who subscribed
#   to our presence.
proc receipts::reply_allowed {xlib from type} {
    variable options

    if {!$options(reply)} { return 0 }
    if {[string equal $type chat]} {
        set chatid [chat::chatid $xlib [::xmpp::jid::removeResource $from]]
        if {[chat::is_groupchat $chatid]} { return 1 }
    }
    return [roster::is_trusted $xlib $from]
}

# When parsing the <received> element, we prefer the value of its "id"
# attribute, if present, over the value of the "id" attribute of the
# enclosing <message> element. This allows to support both v1.1
# and v1.0 versions of XEP-0184.
proc receipts::process_message \
        {xlib from id type is_subject subject body err thread priority x} {
    foreach element $x {
        ::xmpp::xml::split $element tag xmlns attrs cdata subels
        switch -- $tag {
            request {
                if {![string equal $xmlns $::NS(receipts)]} continue
                if {![reply_allowed $xlib $from $type]} continue
                process_receipt_request $xlib $from $id
            }
            received {
                if {![string equal $xmlns $::NS(receipts)]} continue
                set id [::xmpp::xml::getAttr $attrs id $id]
                process_receipt_response $xlib $from $id $type
            }
        }
    }
}

# XMPP-0184 v1.1 suggests mirroring the id attribute of the source
# message only in the <received> tag; mirroring of this attribute
# in the <message> tag is the requirement of v1.0 and below.
# We maintain both of them for backwards compatibility.
proc receipts::process_receipt_request {xlib from id} {
    ::xmpp::sendMessage $xlib $from -id $id \
        -xlist [list [::xmpp::xml::create received \
                                -xmlns $::NS(receipts) \
                                -attrs [list id $id]]]
}

proc receipts::process_receipt_response {xlib from id type} {
    variable requests

    foreach chatid [chat::opened $xlib [::xmpp::jid::removeResource $from]] {
        set cw [chat::chat_win $chatid]

        set name msgid_$id
        if {[lsearch -exact [$cw image names] $name] >= 0} {
            $cw image configure $name -image receipts/confirmed
            return
        }
    }
}

proc receipts::add_receipt_icon {chatid from type body x} {
    if {![string equal $type chat]} return
    if {![richtext::property_exists msgid]} return

    set id [richtext::property_get msgid]

    set cw [chat::chat_win $chatid]
    $cw image create end -name msgid_$id -image receipts/unconfirmed
}

proc receipts::attach_confirmation_request \
                        {xlistVar chatid user id body type} {
    variable options
    if {!$options(request) || ![chat::is_chat $chatid]} return

    upvar 2 $xlistVar xlist

    lappend xlist [::xmpp::xml::create request \
                            -xmlns $::NS(receipts)]

    richtext::property_update msgid $id
}

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