[Tkabber-dev] r22 - in trunk/plugins/autoanswer: . msgs

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Mon Aug 20 19:35:02 MSD 2007


Author: kostix
Date: 2007-08-20 19:35:02 +0400 (Mon, 20 Aug 2007)
New Revision: 22

Added:
   trunk/plugins/autoanswer/autoanswer.tcl
   trunk/plugins/autoanswer/msgs/
   trunk/plugins/autoanswer/msgs/ru.msg
Log:
Initial import of the "autoanswer" plugin.


Added: trunk/plugins/autoanswer/autoanswer.tcl
===================================================================
--- trunk/plugins/autoanswer/autoanswer.tcl	                        (rev 0)
+++ trunk/plugins/autoanswer/autoanswer.tcl	2007-08-20 15:35:02 UTC (rev 22)
@@ -0,0 +1,217 @@
+# $Id$
+# "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 at 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 presense 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 the 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, available 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 options
+
+	# if button not found, don't do anythyng
+	if { [[tbox] index auto_answer] == -1 } {
+		return
+	}
+	if {$options(enabled)} {
+		set txt [::msgcat::mc "Switch autoanswer off"]
+	} else {
+		set txt [::msgcat::mc "Switch autoanswer on"]
+	}
+	[tbox] itemconfigure auto_answer \
+		-command [namespace current]::toggle_active \
+		-text $txt -helptext $txt -relief link
+}
+
+proc autoanswer::toggle_active {} {
+	variable options
+	variable answered
+
+	# Invert the "enabled" flag
+	set options(enabled) [expr {!$options(enabled)}]
+	# reset reply counters
+	if { [array exists answered] } {
+		array unset answered
+	}
+	update_toolbar_button
+}
+
+# Sends the message ($options(message))
+proc autoanswer::process_message {connid from id type \
+		is_subject subject body args} {
+	global userstatus textstatus statusdesc
+	variable options
+	variable answered
+
+	# Do not reply if disabled
+	if { !$options(enabled) } {
+		return
+	}
+	# Do not reply to normal messages
+	if {![string equal $type chat]} {
+		return
+	}
+	set chatid [::chat::chatid $connid $from]
+	# Do not reply in MUCs
+	if { [::chat::is_groupchat $chatid] } {
+		return
+	}
+	set jid [jlib::connection_jid $connid]
+	# Just to make sure the program never replies to itself
+	if { $jid == $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
+	}
+	# Increment the number of times we replied to this JID
+	if { ![info exists answered($from)] } {
+		set answered($from) 1
+	} else {
+		incr answered($from)
+	}
+	# Stop replying after 3 replies
+	if { $answered($from) > 3 } {
+		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
+	}
+}
+
+namespace eval autoanswer {
+	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 {
+		[tbox] add -name auto_answer
+		update_toolbar_button
+	}]
+}
+


Property changes on: trunk/plugins/autoanswer/autoanswer.tcl
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/plugins/autoanswer/msgs/ru.msg
===================================================================
--- trunk/plugins/autoanswer/msgs/ru.msg	                        (rev 0)
+++ trunk/plugins/autoanswer/msgs/ru.msg	2007-08-20 15:35:02 UTC (rev 22)
@@ -0,0 +1,24 @@
+# $Id$
+# vim:enc=utf-8
+
+::msgcat::mcset ru "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 presense status." \
+	"Auto Answer обеспечивает автоответ на входящие сообщения типа \"чат\", посланные указанными контактами, заданным пользователем сообщением, описывающим состояние вашей текущей доступности. Этот плагин особенно удобен для борьбы с контактами, игнорирующими статус вашей доступности."
+::msgcat::mcset ru "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 the single %. If this text is empty (the default) Tkabber will cook for you a polite descriptive message including your availability status and status text." \
+	"Тело сообщения, используемого для автоответа. Перед отсылкой в сообщении раскрываются три ключевых слова: %s раскрывается в текущий статус вашей доступности, %t -- в описание статуса, а %% -- в символ %. Если этот текст является пустой строкой (это значение по умолчанию), Tkabber самостоятельно сформирует вежливый текст, содержащий статус вашей текущей доступности и его описание."
+::msgcat::mcset ru "Enables or disables automatic answering. You can also control this setting from the main toolbar." \
+	"Разрешает или запрещает автоответ. Вы также можете управлеть этой настройкой при помощи кнопки на главной панели инструментов."
+::msgcat::mcset ru "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, available tokens are: available, away, xa and dnd." \
+	"Список состояний доступности, в которых автоответ включается принудительно, независимо от состояния его основной настройки. Это должен быть список ключевых слов, разделённых пробельными символами. Допустимые ключевые слова: available, away, xa и dnd."
+::msgcat::mcset ru "Plugins options." \
+	"Настройки плагинов."
+::msgcat::mcset ru "Regular expression to match JIDs for which auto-answering will be used. A (default) value of \"\" means any JID." \
+	"Регулярное выражение, подходящее под JID'ы, для которых будет использоваться автоответ. Значение по умолчанию \"\" означает любой JID."
+::msgcat::mcset ru "Regular expression to match JIDs for which auto-answering will not be used. A (default) value of \"^$\" means no restrictions." \
+	"Регулярное выражение, подходящее под JID'ы, для которых автоответ использоваться не будет. Значение по умолчанию \"^$\" означает отсутствие ограничений."
+::msgcat::mcset ru "Sorry, but my status is now %s (%s)" \
+	"Извините, но мой текущий статус: %s (%s)"
+::msgcat::mcset ru "Switch autoanswer off" \
+	"Выключить автоответ"
+::msgcat::mcset ru "Switch autoanswer on" \
+	"Включить автоответ"
+


Property changes on: trunk/plugins/autoanswer/msgs/ru.msg
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native



More information about the Tkabber-dev mailing list