# $Id: autoanswer.tcl 340 2010-04-13 18:47:28Z gebb $
# "Auto Answer" plugin for Tkabber.
# This plugin provides for auto-responding to chat messages from certain
# contacts. It's particularly useful to combat contacts that ignore
# your availability status.
# Written by Otto von Gebbels <gebb at ngs dot ru>
# and Konstantin Khomoutov <flatworm@users.sourceforge.net>.

namespace eval autoanswer {
	variable options

	package require msgcat
	::msgcat::mcload [file join [file dir [info script]] msgs]

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

	set group "Auto Answer"

	custom::defgroup $group \
		[::msgcat::mc "Auto Answer provides autoresponding to\
			incoming messages of type \"chat\" sent by certain\
			contacts with the user-provided message or a \"cooked\"\
			message describing your current availability status.\
			This plugin is particularly useful to combat contacts\
			that ignore your availability status."] \
		-group Plugins

	custom::defvar options(enabled) no \
		[::msgcat::mc "Enables or disables automatic answering.\
			You can also control this setting from the main toolbar."] \
		-group $group \
		-type boolean

	custom::defvar options(disable_regex) "^$" \
		[::msgcat::mc "Regular expression to match JIDs for which\
			auto-answering will not be used. A (default) value\
			of \"^$\" means no restrictions."] \
		-group $group \
		-type string

	custom::defvar options(regex) "" \
		[::msgcat::mc "Regular expression to match JIDs for which\
			auto-answering will be used. A (default) value\
			of \"\" means any JID."] \
		-group $group \
		-type string

	custom::defvar options(message) "" \
		[::msgcat::mc "Body of message used for auto-answering.\
			Three special tokens are expanded before sending:\
			%s is expaneded to your current availability status,\
			%t expands to your status text and\
			%% expands to a single %.\
			If this text is empty (the default) Tkabber will cook\
			for you a polite descriptive message including your\
			availability status and status text."] \
		-group $group \
		-type string

	# Changing status to one from this list
	# will automatically turn the auto answer mode on,
	# while entering a status not listed here will turn it off.
	# Comment this set out to make the answer mode 
	# independent of the availability status.
	custom::defvar options(status) {away xa dnd} \
		[::msgcat::mc "List of availability states in which\
			auto-answer is forcibly turned on independently\
			of its main setting. This must be a whitespace-separated\
			list of tokens, valid tokens are: available, away,\
			xa and dnd."] \
		-group $group \
		-type string
	
	unset group
}

proc autoanswer::tbox {} {
	return [.mainframe gettoolbar 0].bbox
}

proc autoanswer::update_toolbar_button {} {
	variable bindex
	variable options
	if {$options(enabled)} {
		set txt [::msgcat::mc "Auto-answer is currently on\nClick to switch it off"]
		set img toolbar/autoanswer/on
	} else {
		set txt [::msgcat::mc "Auto-answer is currently off\nClick to switch it on"]
		set img toolbar/autoanswer/off
	}
	[tbox] itemconfigure $bindex \
		-command [namespace current]::toggle_active \
		-image $img -helptext $txt -relief link
}

proc autoanswer::toggle_active {} {
	variable options
	variable sent

	# Invert the "enabled" flag
	set options(enabled) [expr {!$options(enabled)}]
	# reset reply counters
	if { [array exists sent] } {
		array unset sent
	}
	update_toolbar_button
}

# Sends the message ($options(message))
proc autoanswer::process_message {xlib from id type \
		is_subject subject body args} {
	global userstatus textstatus statusdesc
	variable options
	variable sent

	set chatid [::chat::chatid $xlib $from]
	
	# Do not reply if disabled
	if { !$options(enabled) } {
		return
	}
	# Do not reply to normal messages
	if {![string equal $type chat]} {
		return
	}
	
	# Do not reply in MUCs
	if { [::chat::is_groupchat $chatid] } {
		return
	}
	# The plugin should never reply to itself:
	if { [string equal \
		[xmpp::jid::stripResource [connection_jid $xlib]] \
		[xmpp::jid::stripResource $from]] } return
	# Do not reply if we have sent a message to this
	# jid after the last status change.
	if { [info exists sent($from)] } {
		return
	}
	# Do not reply if regexp rules are not met
	# Do not reply to empty messages
	if { [regexp -nocase $options(disable_regex) $from] \
		|| ![regexp -nocase $options(regex) $from] \
		|| [string equal $body ""] } {
		return
	}

	set cw [chat::winid $chatid]
	set iw [chat::input_win $chatid]

	# Save any text that is currently in the buffer
	if {[$iw compare 1.0 != {end - 1 char}]} {
		set saved [$iw get 1.0 {end - 1 char}] ;# omit trailing newline
	} else {
		set saved ""
	}

	$iw delete 1.0 end
	if {$options(message) != ""} {
		$iw insert end [string map [list \
			%% % \
			%s $statusdesc($userstatus) \
			%t $textstatus \
		] $options(message)]
	} else {
		$iw insert end [::msgcat::mc "Sorry, but my status is now %s (%s)" \
			$statusdesc($userstatus) $textstatus]
	}
	chat::send_message $cw $chatid chat

	if {$saved != ""} {
		$iw insert end $saved
	}
}

# Turns auto answer on or off when status changes
proc autoanswer::on_status_change {name1 name2 op} {
	global userstatus
	variable options

	if { ![info exists options(status)] } {
		return
	}
	# Enable auto answer if current status is in the $::answ_status list
	if { [lsearch -exact $options(status) $userstatus] >= 0 } {
		# Don't do anything if auto answer is already enabled
		if { $options(enabled) } {
			return
		}
		toggle_active
		return
	}
	# Disable auto answer if current status is not in the $::answ_status list
	if { $options(enabled) } {
		toggle_active
	}
}

# Sets the "message sent" flag for the jid.
proc autoanswer::on_send {chatid user body type} {
	variable sent

	set jid [::chat::get_jid $chatid]

	if { ![info exists sent($jid)] } {
		set sent($jid) 1
	}
}


namespace eval autoanswer {
	image create photo toolbar/autoanswer/on \
		-file [file join [file dir [info script]] \
			images default answerback_on.gif]
	image create photo toolbar/autoanswer/off \
		-file [file join [file dir [info script]] \
			images default answerback_off.gif]

	hook::add process_message_hook \
		[namespace current]::process_message 150

	trace add variable ::userstatus write \
		[namespace current]::on_status_change

	hook::add finload_hook [namespace code {
		variable bindex [ifacetk::add_toolbar_button \
			toolbar/autoanswer/on "" ""]
		# Actual icon, helptext and command are assigned here:
		update_toolbar_button
	}]

	hook::add chat_send_message_hook  \
		[namespace current]::on_send 89
}

