# $Id: receipts.tcl 1973 2010-12-03 02:10:43Z kostix $
# Support for XEP-0184 "Message Receipts" (v1.1 and 1.0).
# Written by Konstantin Khomoutov <flatworm@users.sourceforge.net>
# Artwork by Artem Bannikov <bannikov.artyom at gmail dot com>
# See README for usage guidelines.
# See license.terms for legal details on usage and distribution.

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} {
	image create photo 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 5

    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 5

    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::stripResource $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::stripResource $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:noet

