[Tkabber-dev] r994 - in trunk/tkabber: . plugins/chat

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sat Mar 3 22:44:00 MSK 2007


Author: sergei
Date: 2007-03-03 22:43:58 +0300 (Sat, 03 Mar 2007)
New Revision: 994

Added:
   trunk/tkabber/plugins/chat/abbrev.tcl
Modified:
   trunk/tkabber/ChangeLog
Log:
	* plugins/chat/abbrev.tcl: Added new plugin, which allows to
	  abbreviate words in chat input windows. <Shift-Space> expands
	  abbreviations (thanks to Konstantin Khomoutov).


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2007-03-03 18:15:25 UTC (rev 993)
+++ trunk/tkabber/ChangeLog	2007-03-03 19:43:58 UTC (rev 994)
@@ -19,6 +19,10 @@
 	* plugins/general/remote.tcl: Allow action execute at the final
 	  ad-hoc command step.
 
+	* plugins/chat/abbrev.tcl: Added new plugin, which allows to
+	  abbreviate words in chat input windows. <Shift-Space> expands
+	  abbreviations (thanks to Konstantin Khomoutov).
+
 2007-03-02  Sergei Golovan  <sgolovan at nes.ru>
 
 	* ifacetk/iface.tcl, privacy.tcl: Redone accepting messages from

Added: trunk/tkabber/plugins/chat/abbrev.tcl
===================================================================
--- trunk/tkabber/plugins/chat/abbrev.tcl	                        (rev 0)
+++ trunk/tkabber/plugins/chat/abbrev.tcl	2007-03-03 19:43:58 UTC (rev 994)
@@ -0,0 +1,134 @@
+# $Id$
+# "abbrev" Tkabber plugin -- "Chat input abbreviations".
+# Written by Konstantin Khomoutov <flatworm at users.sourceforge.net>
+
+# TODO More comments
+# TODO extensive testing
+
+namespace eval abbrev {
+    variable abbrevs
+    array set abbrevs {}
+    trace variable [namespace current]::abbrevs w \
+	  [namespace current]::store_abbrevs
+
+    custom::defvar stored_abbrevs {} \
+	"List of chat input abbreviations" \
+	-group Hidden \
+	-type string
+
+    bind TextAbbrevs <Shift-KeyPress-space> \
+	 [list [namespace current]::expand_abbrevs %W]
+}
+
+proc abbrev::command_comps {chatid compsvar wordstart line} {
+    upvar 0 $compsvar comps
+
+    if {!$wordstart} {
+	lappend comps {/abbrev } {/unabbrev } {/listabbrevs }
+    }
+}
+
+hook::add generate_completions_hook \
+	  [namespace current]::abbrev::command_comps
+
+proc abbrev::handle_command {chatid user body type} {
+    variable abbrevs
+
+    if {[string match "/abbrev*" $body]} {
+	if {![regexp {^/abbrev\s+(\S+)\s+(.*)$} $body - what for]} {
+	    show error $chatid [msgcat::mc "Usage: /abbrev WHAT FOR"]
+	    return stop
+	}
+
+	set abbrevs($what) $for		
+	show info $chatid [msgcat::mc "Added abbreviation:\n%s: %s" \
+				  $what $for]
+    } elseif {[string match "/unabbrev*" $body]} {
+	if {![regexp {^/unabbrev\s+(\S+)} $body - what]} {
+	    show error $chatid [msgcat::mc "Usage: /unabbrev WHAT"]
+	    return stop
+	}
+
+	# Handle special case: * stands for "all abbreviations":
+	if {[string equal $what *]} {
+	    array unset abbrevs *
+	    show info $chatid [msgcat::mc "Purged all abbreviations" $what]
+	    return stop
+	}
+		
+	if {[catch {unset abbrevs($what)}]} {
+	    show error $chatid [msgcat::mc "No such abbreviation: %s" $what]
+	    return stop
+	} else {
+	    show info $chatid [msgcat::mc "Deleted abbreviation: %s" $what]
+	}
+    } elseif {[string match "/listabbrevs*" $body]} {
+	set out [msgcat::mc "Abbreviations:"]
+	foreach ab [array names abbrevs] {
+	    append out "\n$ab: $abbrevs($ab)"
+	}
+	show info $chatid $out
+    } else {
+	return
+    }
+
+    return stop
+}
+
+hook::add chat_send_message_hook \
+	  [namespace current]::abbrev::handle_command 15
+
+proc abbrev::install_bindtag {chatid type} {
+    set iw [chat::input_win $chatid]
+
+    set bt [bindtags $iw]
+    set ix [lsearch -exact $bt Text]
+    if {$ix < 0} return ;# very, very strange...
+
+    bindtags $iw [linsert $bt $ix TextAbbrevs]
+}
+
+hook::add open_chat_post_hook \
+	  [namespace current]::abbrev::install_bindtag
+
+proc abbrev::expand_abbrevs {w} {
+    variable abbrevs
+
+    if {[catch {tk::TextPrevPos $w insert tcl_startOfPreviousWord} from]} {
+	set from [tkTextPrevPos $w insert tcl_startOfPreviousWord]
+    }
+    set what [$w get $from insert]
+
+    if {[info exists abbrevs($what)]} {
+	set for $abbrevs($what)
+	$w delete $from insert
+	$w insert $from $for
+    }
+}
+
+proc abbrev::store_abbrevs args {
+    variable abbrevs
+    variable stored_abbrevs
+
+    set stored_abbrevs [array get abbrevs]
+}
+
+proc abbrev::restore_abbrevs args {
+    variable abbrevs
+    variable stored_abbrevs
+
+    array set abbrevs $stored_abbrevs
+}
+
+# Prio of this handler must be > 60 since customize db is read at 60
+hook::add postload_hook \
+	  [namespace current]::abbrev::restore_abbrevs 70
+
+# $type should be either "info" or "error"
+proc abbrev::show {type chatid msg} {
+    set jid [chat::get_jid $chatid]
+    set cw [chat::chat_win $chatid]
+
+    chat::add_message $chatid $jid $type $msg {}
+}
+


Property changes on: trunk/tkabber/plugins/chat/abbrev.tcl
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Revision
Name: svn:eol-style
   + native



More information about the Tkabber-dev mailing list