# $Id: receipts.tcl 1426 2008-05-18 07:29:11Z sergei $
# Support for XEP-0184 "Message Receipts" (v1.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 {
    set ::NS(receipts) urn:xmpp:receipts

    ::msgcat::mcload [file join [file dirname [info script]] msgs]

    foreach item {confirmed unconfirmed} {
	image create photo receipts/$item \
	    -file [file join [file dirname [info script]] images $item.gif]
    }
    unset item

    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)

    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
}

# 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 {connid from type} {
    variable options

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

proc receipts::process_message \
	{connid from id type is_subject subject body err thread priority x} {
    foreach element $x {
	jlib::wrapper:splitxml $element tag vars isempty chdata children
	switch -- $tag {
	    request {
		set xmlns [jlib::wrapper:getattr $vars xmlns]
		if {![string equal $xmlns $::NS(receipts)]} continue
		if {![reply_allowed $connid $from $type]} continue
		process_receipt_request $connid $from $id
	    }
	    received {
		set xmlns [jlib::wrapper:getattr $vars xmlns]
		if {![string equal $xmlns $::NS(receipts)]} continue
		process_receipt_response $connid $from $id $type
	    }
	}
    }
}

proc receipts::process_receipt_request {connid from id} {
    jlib::send_msg $from -id $id \
	-xlist [list [jlib::wrapper:createtag received \
	    -vars [list xmlns $::NS(receipts)]]] \
	-connection $connid
}

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

    set chatid [chat::chatid $connid $from]
    if {![chat::is_opened $chatid]} return
    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 body type} {
    variable options
    if {!$options(request) || ![chat::is_chat $chatid]} return

    global chat_msg_id
    upvar 2 $xlistVar xlist

    lappend xlist [jlib::wrapper:createtag request \
		    -vars [list xmlns $::NS(receipts)]]

    richtext::property_update msgid $chat_msg_id
}

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

