[Tkabber-dev] r1189 - in trunk/tkabber-plugins: . attline presencecmd

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Fri Aug 17 20:53:15 MSD 2007


Author: sergei
Date: 2007-08-17 20:53:14 +0400 (Fri, 17 Aug 2007)
New Revision: 1189

Added:
   trunk/tkabber-plugins/attline/
   trunk/tkabber-plugins/attline/AUTHORS
   trunk/tkabber-plugins/attline/BUGS
   trunk/tkabber-plugins/attline/TODO
   trunk/tkabber-plugins/attline/attline.tcl
   trunk/tkabber-plugins/attline/license.terms
   trunk/tkabber-plugins/presencecmd/
   trunk/tkabber-plugins/presencecmd/AUTHORS
   trunk/tkabber-plugins/presencecmd/INSTALL
   trunk/tkabber-plugins/presencecmd/README
   trunk/tkabber-plugins/presencecmd/TODO
   trunk/tkabber-plugins/presencecmd/VERSION
   trunk/tkabber-plugins/presencecmd/license.terms
   trunk/tkabber-plugins/presencecmd/presencecmd.tcl
Modified:
   trunk/tkabber-plugins/ChangeLog
   trunk/tkabber-plugins/Makefile
   trunk/tkabber-plugins/README
Log:
	* attline/*: Added new plguin which draws an attention line in chat
	  windows (thanks to Konstantin Khomoutov).

	* presencecmd/*: Added new plugin which introduces several chat
	  commands changing user's presence information (thanks to Konstantin
	  Khomoutov).

	* README: Added short descriptions of attline and presencecmd plugins.

	* Makefile: Added new plugins.


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2007-08-16 09:00:46 UTC (rev 1188)
+++ trunk/tkabber-plugins/ChangeLog	2007-08-17 16:53:14 UTC (rev 1189)
@@ -1,3 +1,16 @@
+2007-08-17  Sergei Golovan <sgolovan at nes.ru>
+
+	* attline/*: Added new plguin which draws an attention line in chat
+	  windows (thanks to Konstantin Khomoutov).
+
+	* presencecmd/*: Added new plugin which introduces several chat
+	  commands changing user's presence information (thanks to Konstantin
+	  Khomoutov).
+
+	* README: Added short descriptions of attline and presencecmd plugins.
+
+	* Makefile: Added new plugins.
+
 2007-08-11  Sergei Golovan <sgolovan at nes.ru>
 
 	* bc/bc.tcl, checkers/checkers.tcl, chess/chess.tcl, mute/mute.tcl,

Modified: trunk/tkabber-plugins/Makefile
===================================================================
--- trunk/tkabber-plugins/Makefile	2007-08-16 09:00:46 UTC (rev 1188)
+++ trunk/tkabber-plugins/Makefile	2007-08-17 16:53:14 UTC (rev 1189)
@@ -5,6 +5,7 @@
 DOCDIR = $(PREFIX)/share/doc/tkabber-plugins
 
 SUBDIRS = aniemoticons \
+	  attline      \
 	  bc           \
 	  checkers     \
 	  chess        \
@@ -17,6 +18,7 @@
 	  mute         \
 	  osd          \
 	  quiz         \
+	  presencecmd  \
 	  renju        \
 	  reversi      \
 	  socials      \

Modified: trunk/tkabber-plugins/README
===================================================================
--- trunk/tkabber-plugins/README	2007-08-16 09:00:46 UTC (rev 1188)
+++ trunk/tkabber-plugins/README	2007-08-17 16:53:14 UTC (rev 1189)
@@ -12,8 +12,13 @@
 Short Description of the Included Plugins
 
 aniemoticons
-    Plugin, which adds support of animated emoticons.
+    Plugin which adds support of animated emoticons.
 
+attline
+    Plugin which draws so-called attention line - a line before the first
+    message in a chat window where the window has lost keyboard focus. All
+    messages after the line are unread messages.
+
 bc
     A word game. Inludes a russian file.
 
@@ -68,6 +73,10 @@
 quiz
     Adaptation of He3hauka (a russian quiz game for IRC).
 
+presencecmd
+    Plugin which adds several commands in a chat window. They change user's
+    presence information (global or directed).
+
 renju
     Gomoku and Renju (in fact, renju is not implemented yet) game for two
     players. When installed, you can send an invitation to your contact

Added: trunk/tkabber-plugins/attline/AUTHORS
===================================================================
--- trunk/tkabber-plugins/attline/AUTHORS	                        (rev 0)
+++ trunk/tkabber-plugins/attline/AUTHORS	2007-08-17 16:53:14 UTC (rev 1189)
@@ -0,0 +1 @@
+Konstantin Khomoutov <flatworm at users.sourceforge.com>

Added: trunk/tkabber-plugins/attline/BUGS
===================================================================
--- trunk/tkabber-plugins/attline/BUGS	                        (rev 0)
+++ trunk/tkabber-plugins/attline/BUGS	2007-08-17 16:53:14 UTC (rev 1189)
@@ -0,0 +1,26 @@
+$Id: BUGS 7 2007-06-25 17:51:25Z kostix $
+
+! Don't work with NotePad in 0.10.0. [.nb raise] returns ""
+when called from open_chat_post_hook event handler...
+
+bug in buttonbar.tcl:
+
+Hook got_focus_hook failed
+Procedure ::plugins::atline::on_focused returned code 1
+bad window path name ".pages.ftab_0"
+bad window path name ".pages.ftab_0"
+    while executing
+"pack slaves [.nb getframe $page]"
+    (procedure "ifacetk::nbpath" line 2)
+    invoked from within
+"ifacetk::nbpath $tab"
+    (procedure "active_chatid" line 9)
+    invoked from within
+"active_chatid $w"
+    (procedure "::plugins::atline::on_focused" line 2)
+    invoked from within
+"::plugins::atline::on_focused ."
+    ("eval" body line 1)
+    invoked from within
+"eval $func $args "
+

Added: trunk/tkabber-plugins/attline/TODO
===================================================================
--- trunk/tkabber-plugins/attline/TODO	                        (rev 0)
+++ trunk/tkabber-plugins/attline/TODO	2007-08-17 16:53:14 UTC (rev 1189)
@@ -0,0 +1,22 @@
+$Id: TODO 12 2007-07-12 16:22:22Z kostix $
+
+* Remove att. line when a buffer marked as read loses focus
+  instead of moving it to the bottom may be?
+
+* Test removal of expired line.
+
+* Test and re-test the code after various conditions.
+
+* Write ChangeLog, INSTALL, README, etc. files.
+
+* Remove references to [assert] since starpacks don't have it.
+
+WIBNIs:
+
+* Check whether the att. line can be made even thinner.
+
+* Calculation of line width isn't quite correct: left padding
+  seems to be more than right.
+
+* Get rid of "accessor" proc since only one is finally needed.
+

Added: trunk/tkabber-plugins/attline/attline.tcl
===================================================================
--- trunk/tkabber-plugins/attline/attline.tcl	                        (rev 0)
+++ trunk/tkabber-plugins/attline/attline.tcl	2007-08-17 16:53:14 UTC (rev 1189)
@@ -0,0 +1,319 @@
+# $Id: attline.tcl 12 2007-07-12 16:22:22Z kostix $
+# "Attention line" -- chat plugin for Tkabber.
+# Draws horizontal line in chat windows separating read and unread messages.
+# Written by Konstantin Khomoutov <flatworm at users.sourceforge.net>
+# See license.terms for the terms of distribution.
+
+option add *Chat.attentionLineHeight        1     widgetDefault
+option add *Chat.attentionLineColor         red   widgetDefault
+option add *Chat.attentionLinePadX          5     widgetDefault
+option add *Chat.attentionLinePadY          0     widgetDefault
+
+namespace eval atline {
+	package require control
+	namespace import ::control::assert
+	control::control assert enabled yes
+
+	variable state
+	variable options
+
+	proc my what {
+		return [uplevel 1 namespace current]::$what
+	}
+	proc mycmd args {
+		lreplace $args 0 0 [my [lindex $args 0]]
+	}
+
+	custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber
+
+	custom::defgroup {Attention Line} \
+		[::msgcat::mc "Attention Line chat plugin options.\
+			This plugin draws horizontal line separating\
+			read and unread messages in chat windows."] \
+		-group Plugins \
+		-group Chat
+
+	custom::defvar options(expires_after) 1000 \
+		[::msgcat::mc "Time (in milliseconds) after which unread messages\
+			in the currently active chat window are considered read and\
+			the attention line is considered expired."] \
+		-group {Attention Line} \
+		-type integer
+
+	custom::defvar options(remove_expired) false \
+		[::msgcat::mc "Remove the attention line after it was expired\
+			from its chat window."] \
+		-group {Attention Line} \
+		-type boolean
+
+	hook::add open_chat_post_hook [my setup_chat_win]
+	# must perform after the hook from 'log on open' plugin:
+	hook::add open_chat_post_hook [my draw_chat_history_separator] 101
+
+	# must perform earlier than drawing of timestamp:
+	# TODO UGLY HACK: rev 1149 introcuced hook prios as real numbers,
+	# before they were integers. Really we should use 5.5, but we must
+	# use integer number for older revisions:
+	if {[string first -integer [info body ::hook::add]] < 0} {
+		hook::add draw_message_hook [my on_draw_message] 5.5
+	} else {
+		hook::add draw_message_hook [my on_draw_message] 14
+	}
+
+	hook::add got_focus_hook  [my on_focused]
+	hook::add lost_focus_hook [my on_lost_focus]
+
+	set accessor {
+		proc [namespace current]::%1$s {cw {val ""}} {
+			variable state
+			if {$val == ""} {
+				return $state($cw,%1$s)
+			} else {
+				set state($cw,%1$s) $val
+			}
+		}
+	}
+
+	eval [format $accessor unread]
+
+	unset accessor
+}
+
+proc atline::setup_chat_win {chatid type} {
+	variable state
+	set cw [chat::chat_win $chatid]
+	set iw [chat::input_win $chatid]
+
+	set state($cw,mainwindow) [chat::winid $chatid]
+
+	#unread $cw [expr {![has_focus $chatid]}]
+	unread $cw false
+
+	bind $cw <Destroy> +[mycmd cleanup $cw %W]
+
+	bind $iw <<ChatSeeAttentionLine>> +[mycmd see_attention_line $cw]
+
+	return
+}
+
+proc atline::cleanup {w1 w2} {
+	if {![string equal $w1 $w2]} return
+
+	cancel_atline_expiration $w1
+
+	variable state
+	array unset state $w1,*
+}
+
+proc atline::getopt {cw opt} {
+	variable state
+
+	chat::query_optiondb $state($cw,mainwindow) $opt
+}
+
+proc atline::on_draw_message {chatid from type body x} {
+	if {[is_delayed $x]} return
+
+	set cw [chat::chat_win $chatid]
+
+	if {![has_focus $chatid] && ![unread $cw]} {
+		unread $cw true
+		# TODO implement [redraw_...]
+		if {[drawn $cw]} {
+			debugmsg atline "deleting old"
+			delete_attention_line $cw
+		}
+		debugmsg atline "drawing"
+		draw_attention_line $cw
+	}
+
+	return
+}
+
+proc atline::is_delayed xml {
+	foreach xelem $xml {
+		::jlib::wrapper:splitxml $xelem tag vars isempty chdata children
+		switch -- [::jlib::wrapper:getattr $vars xmlns] {
+			urn:xmpp:delay -
+			jabber:x:delay {
+				return 1
+			}
+		}
+	}
+	return 0
+}
+
+proc atline::drawn cw {
+	expr {[$cw tag ranges ATLINE] != {}}
+}
+
+proc atline::draw_chat_history_separator {chatid type} {
+	if {[string equal $type chat]} {
+		set cw [chat::chat_win $chatid]
+		# Draw only if text widget isn't empty (has some history lines):
+		if {[$cw compare 1.0 < end-1c]} {
+			draw_attention_line [chat::chat_win $chatid]
+		}
+	}
+
+	return
+}
+
+proc atline::draw_attention_line cw {
+	variable state
+
+	if {[drawn $cw]} return
+
+	set al $cw.attention_line
+	if {![winfo exists $al]} {
+		frame $al
+		bind $cw <Configure> +[mycmd reconfigure_attention_line $cw $al]
+		# Prevent destructed attention line from killing its parent
+		# in windowed mode when there's no explicit handler and the
+		# event is forwarded upstream:
+		bind $al <Destroy> +break
+	}
+
+	set start [$cw index end-1c]
+	$cw window create end -window $al
+	$cw insert end \n
+	$cw tag add ATLINE $start end-1c
+
+	reconfigure_attention_line $cw $al
+
+	debugmsg atline "drawn"
+}
+
+proc atline::delete_attention_line cw {
+	if {![drawn $cw]} return
+
+	set state [$cw cget -state]
+	$cw configure -state normal
+	$cw delete ATLINE.first ATLINE.last
+	$cw configure -state $state
+
+	debugmsg atline "deleted"
+}
+
+proc atline::see_attention_line cw {
+	if {![drawn $cw]} return
+
+	$cw see ATLINE.first
+}
+
+proc atline::internal_width cw {
+	# We assume $cw is mapped...
+	expr { [winfo width $cw] - 2 * [$cw cget -borderwidth] }
+}
+
+proc atline::reconfigure_attention_line {cw al} {
+	if {![winfo exists $al]} return
+
+	set padx [getopt $cw attentionLinePadX]
+	assert {string is integer -strict $padx}
+	$al configure \
+		-background [getopt $cw attentionLineColor] \
+		-height     [getopt $cw attentionLineHeight] \
+		-width      [expr {[internal_width $cw] - 2 * $padx }]
+	$cw window configure ATLINE.first \
+		-padx       $padx \
+		-pady       [getopt $cw attentionLinePadY] \
+}
+
+proc atline::has_focus chatid {
+	global usetabbar
+
+	if {$usetabbar} {
+		expr {![string equal [focus -displayof .] ""] \
+			&& [string equal [chat::winid $chatid] [ifacetk::nbpath [.nb raise]]]}
+	} else {
+		set fw [focus -displayof .]
+		expr {![string equal $fw ""] \
+			&& [string equal [winfo toplevel $fw] [chat::winid $chatid]]}
+	}
+}
+
+proc atline::on_focused w {
+	set chatid [active_chatid $w]
+	if {$chatid == ""} return
+
+	set cw [chat::chat_win $chatid]
+	debugmsg atline "focused; unread? [unread $cw]"
+	if {[unread $cw]} {
+		see_attention_line $cw
+		schedule_atline_expiration $cw
+	}
+}
+
+proc atline::on_lost_focus w {
+	set chatid [active_chatid $w]
+	if {$chatid == ""} return
+
+	set cw [chat::chat_win $chatid]
+	debugmsg atline "lost focus; unread? [unread $cw]"
+	if {[unread $cw]} {
+		cancel_atline_expiration $cw
+	} elseif {[drawn $cw]} {
+		delete_attention_line $cw
+		draw_attention_line $cw
+	}
+}
+
+proc atline::active_chatid w {
+	global usetabbar
+	variable ::chat::chat_id
+
+	if {$usetabbar} {
+		# $w is always "." here...
+		set tab [.nb raise]
+		if {[string equal $tab ""]} return
+		set winid [ifacetk::nbpath $tab]
+	} else {
+		set winid $w
+	}
+
+	expr {
+		[info exists chat_id($winid)]
+		? $chat_id($winid)
+		: ""
+	}
+}
+
+proc atline::schedule_atline_expiration cw {
+	variable state
+	variable options
+
+	set exptime $options(expires_after)
+
+	if {$exptime <= 0} {
+		# Immediate expiration:
+		unread $cw false
+		debugmsg atline "expired immediately"
+	}
+
+	assert {![info exists state($cw,expiring)]}
+	set state($cw,expiring) [after $exptime [mycmd expire_attention_line $cw]]
+	debugmsg atline "expiration scheduled for after $exptime"
+}
+
+proc atline::cancel_atline_expiration cw {
+	variable state
+	if {[info exists state($cw,expiring)]} {
+		after cancel $state($cw,expiring)
+		unset state($cw,expiring)
+		debugmsg atline "expiration cancelled"
+	}
+}
+
+proc atline::expire_attention_line cw {
+	variable state
+	variable options
+
+	unread $cw false
+	unset state($cw,expiring)
+	if {$options(remove_expired)} {
+		delete_attention_line $cw
+	}
+	debugmsg atline "expired"
+}
+

Added: trunk/tkabber-plugins/attline/license.terms
===================================================================
--- trunk/tkabber-plugins/attline/license.terms	                        (rev 0)
+++ trunk/tkabber-plugins/attline/license.terms	2007-08-17 16:53:14 UTC (rev 1189)
@@ -0,0 +1,19 @@
+Copyright (c) 2007 Konstantin Khomoutov <flatworm at users.sourceforge.net>
+
+Permission is hereby granted, free of charge, to any person obtaining a
+copy of this software and associated documentation files (the "Software"),
+to deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute, sublicense,
+and/or sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+DEALINGS IN THE SOFTWARE.

Added: trunk/tkabber-plugins/presencecmd/AUTHORS
===================================================================
--- trunk/tkabber-plugins/presencecmd/AUTHORS	                        (rev 0)
+++ trunk/tkabber-plugins/presencecmd/AUTHORS	2007-08-17 16:53:14 UTC (rev 1189)
@@ -0,0 +1 @@
+Konstantin Khomoutov <flatworm at users.sourceforge.com>

Added: trunk/tkabber-plugins/presencecmd/INSTALL
===================================================================
--- trunk/tkabber-plugins/presencecmd/INSTALL	                        (rev 0)
+++ trunk/tkabber-plugins/presencecmd/INSTALL	2007-08-17 16:53:14 UTC (rev 1189)
@@ -0,0 +1,9 @@
+As usually, copy this directory under the ~/.tkabber/plugins directory
+so that you get a hierarchy like this:
+  ~/.tkabber/plugins
+  ~/.tkabber/plugins/presencecmd/
+  ~/.tkabber/plugins/presencecmdv/presencecmd.tcl
+
+Restart Tkabber, to get the plugin loaded.
+Consult the README file for the details about using this plugin.
+

Added: trunk/tkabber-plugins/presencecmd/README
===================================================================
--- trunk/tkabber-plugins/presencecmd/README	                        (rev 0)
+++ trunk/tkabber-plugins/presencecmd/README	2007-08-17 16:53:14 UTC (rev 1189)
@@ -0,0 +1,115 @@
+"Presence command" chat plugin for Tkabber.
+$Id: README 16 2007-07-14 15:31:04Z kostix $
+
+I. The idea.
+
+This plugin provides additional set of what are called
+"IRC-style chat commands" in Tkabber -- specially formatted
+messages which are recognized as commands to Tkabber. They are
+parsed and executed, then  their text is thrown away (widely
+known examples of standard chat commands are: /clear, /nick,
+/ban, /leave, etc).
+
+Provided commands are:
+* /presence allows to change "master" (i.e. basic, main,
+  global) presence of the user [1];
+* /chatpresence (or its alias /thispresence) allows to change
+  the presence in this chat session (which may be a MUC room)
+  only, in other words it sends what is called "directed
+  presence" to the chat peer or room [2]. (See also "Notes"
+  section below.)
+
+II. Usage.
+
+Both commands have identical syntax and they behave identically
+-- changes only the presence they operate on.
+
+The formal syntax is:
+/presence ?presence|clear[status]?
+?status message?
+
+Fields surrounded by "?" represent optional parts, so does text
+in [...]. "|" specifies alteration (a set of mutually exclusive
+options).
+
+Note that while both presence and status message fields are
+marked optional at least one of them MUST appear. Otherwise the
+command has no sense and the usage info is shown in the chat
+log window.
+
+The presence field may have this (standard) values, literally:
+* available -- user is available;
+* avail -- shortcut for "available";
+* away -- user is away;
+* xa -- user is extended away;
+* dnd -- user doesn't want to be disturbed;
+* chat -- user is free for chat.
+
+Note that there's currently no support for "unavailable"
+presence.
+
+The special value of the presence field is "clearstatus"
+("clear" is a shortcut to it). When spceified, the status
+message is set to the empty string; the presence itself isn't
+changed. (See also section "Notes" below.)
+
+The status message field may be used to provide status message
+for the presence. Any text, on a new line after the command (and
+the presence value, if specified) is treated as the status
+message, so it can span multiple lines and have empty lines in
+between. The only transformation that is applied to the status
+message is removal of any leading and trailing whitespace.
+
+Any of this fields both) may be omitted. In this case
+the current value for the omitted field is kept intact.
+
+III. Examples:
+
+Set the "do not disturb" master presence:
+/presence dnd
+
+Set the "free to chat" presence with a fancy status message:
+/presence chat
+Hey girls!
+
+Just change the status message while keeping the presence
+intact:
+/presence
+To be, or not to be --
+That is the question.
+
+Send directed presence to the chat peer (or to the room you're
+in):
+/chatpresence xa
+Gone shopping
+
+Just change the status message seen by the chat peer (or in the
+room):
+/thispresence
+Gone nuts emerging ebuilds
+
+IV. Notes.
+
+1. You should understand that directed presence is somewhat odd
+in its behaviour to many (not to say most) users: any change in
+master presence invalidates any directed presences which were
+set before. In other words if you set, say, "dnd" presence in
+some MUC room and then change your master presence to "chat",
+this one will be broadcasted to that room also changing your
+presence there to "chat".
+
+2. Oddly enough, but currently there's no easy way in Tkabber to
+sent *really* empty status message: if Tkabber is told to send
+one it replaces it with the "canonical" spelling of the presence
+being set in your locale. I.e. when you set the available
+presence with the empty status message and have an English
+locale, Tkabber will cook the "Available" status message for
+you. This is done so that presence stanzas can be PGP-signed, if
+PGP encryption is enabled.
+
+V. References:
+
+1. http://www.xmpp.org/rfcs/rfc3921.html#presence
+2. http://www.xmpp.org/rfcs/rfc3921.html#presence-resp-directed
+
+vim:et:ts=4:sw=4:tw=64

Added: trunk/tkabber-plugins/presencecmd/TODO
===================================================================
--- trunk/tkabber-plugins/presencecmd/TODO	                        (rev 0)
+++ trunk/tkabber-plugins/presencecmd/TODO	2007-08-17 16:53:14 UTC (rev 1189)
@@ -0,0 +1,10 @@
+$Id: TODO 16 2007-07-14 15:31:04Z kostix $
+
+HIGH:
+
+LOW:
+
+* Write provide ChangeLog and VERSION files.
+
+* Russian message catalog.
+

Added: trunk/tkabber-plugins/presencecmd/VERSION
===================================================================
--- trunk/tkabber-plugins/presencecmd/VERSION	                        (rev 0)
+++ trunk/tkabber-plugins/presencecmd/VERSION	2007-08-17 16:53:14 UTC (rev 1189)
@@ -0,0 +1 @@
+0.2, 14-July-2007

Added: trunk/tkabber-plugins/presencecmd/license.terms
===================================================================
--- trunk/tkabber-plugins/presencecmd/license.terms	                        (rev 0)
+++ trunk/tkabber-plugins/presencecmd/license.terms	2007-08-17 16:53:14 UTC (rev 1189)
@@ -0,0 +1,19 @@
+Copyright (c) 2007 Konstantin Khomoutov <flatworm at users.sourceforge.net>
+
+Permission is hereby granted, free of charge, to any person obtaining a
+copy of this software and associated documentation files (the "Software"),
+to deal in the Software without restriction, including without limitation
+the rights to use, copy, modify, merge, publish, distribute, sublicense,
+and/or sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+DEALINGS IN THE SOFTWARE.

Added: trunk/tkabber-plugins/presencecmd/presencecmd.tcl
===================================================================
--- trunk/tkabber-plugins/presencecmd/presencecmd.tcl	                        (rev 0)
+++ trunk/tkabber-plugins/presencecmd/presencecmd.tcl	2007-08-17 16:53:14 UTC (rev 1189)
@@ -0,0 +1,127 @@
+# $Id: presencecmd.tcl 16 2007-07-14 15:31:04Z kostix $
+# "Presence commands" -- Tkabber chat plugin.
+# Provides two IRC-style chat commands that provide
+# for manipulating user's presence and/or assotiated status message
+# as well as sending directed presence to the chat peer (or room).
+# Written by Konstantin Khomoutov <flatworm at users.sourceforge.net>
+# See license.terms for details on distribution.
+# See INSTALL and README for details on installation and usage.
+
+namespace eval presencecmd {
+	hook::add generate_completions_hook \
+		[namespace current]::command_comps
+	hook::add chat_send_message_hook \
+		[namespace current]::handle_command 15
+}
+
+proc presencecmd::command_comps {chatid compsvar wordstart line} {
+	upvar 0 $compsvar comps
+    
+	if {!$wordstart} {
+		lappend comps {/presence } {/chatpresence } {/thispresence }
+	}
+}
+
+proc presencecmd::handle_command {chatid user body type} {
+	global userstatus
+
+	if {[string match {/presence*} $body]} {
+		set cmd /presence
+	} elseif {[string match {/chatpresence*} $body]} {
+		set cmd /chatpresence
+	} elseif {[string match {/thispresence*} $body]} {
+		set cmd /thispresence
+	} else return
+
+	set fields [split $body \n]
+	set pres   [string trim [string range [lindex $fields 0] [string length $cmd] end]]
+	set status [string trim [join [lrange $fields 1 end] \n]]
+	set sendstatus [expr {$status != ""}]
+
+	if {$pres == "" && !$sendstatus} {
+		show_usage $chatid
+		return stop
+	}
+
+	if {$pres != ""} {
+		switch -- $pres {
+			avail {
+				set pres available
+			}
+			available -
+			away -
+			xa -
+			dnd -
+			chat {
+			}
+			clear -
+			clearstatus {
+				set sendstatus true
+				set pres $userstatus
+				set status ""
+			}
+			default {
+				show error $chatid [::msgcat::mc "Unknown presence \"%s\".\
+					Must be avail\[able\], away, xa, dnd, chat or clear\[status\]" $pres]
+				return stop
+			}
+		}
+	} else {
+		set pres $userstatus
+	}
+
+	switch -- $cmd {
+		/presence {
+			set_master_presence $pres $status $sendstatus
+		}
+		/chatpresence -
+		/thispresence {
+			send_directed_presence $chatid $pres $status $sendstatus
+		}
+	}
+
+	return stop
+}
+
+proc presencecmd::set_master_presence {pres status sendstatus} {
+	global userstatus textstatus
+
+	if {$sendstatus} { set textstatus $status }
+	set userstatus $pres ;# this triggers sending the presence
+}
+
+proc presencecmd::send_directed_presence {chatid pres status sendstatus} {
+	global userpriority
+
+	set cmd [list send_presence $pres \
+		-to [chat::get_jid $chatid] \
+		-pri $userpriority \
+		-connection [chat::get_connid $chatid]]
+
+	if {$sendstatus} {
+		lappend cmd -stat $status
+	}
+
+	eval $cmd
+}
+
+proc presencecmd::show_usage chatid {
+	show error $chatid [::msgcat::mc "Usage:\
+		\t/presence ?presence|clear\[status\]?\n\
+		\t?status message?\n\
+		or\n\
+		\t/chatpresence ?presence|clear\[status\]?\n\
+		\t?status message?\n\
+		Where presence is one of: avail\[able\], away, xa, dnd, chat.\n\
+		Special presence \"clear\[status\]\" just clears the current status.\n\
+		/thispresence is an alias for /chatpresence"]
+}
+
+# $type should be either "info" or "error"
+proc presencecmd::show {type chatid msg} {
+	set jid [chat::get_jid $chatid]
+	set cw [chat::chat_win $chatid]
+
+	chat::add_message $chatid $jid $type $msg {}
+}
+



More information about the Tkabber-dev mailing list