[Tkabber-dev] r86 - in trunk/plugins/customstatus: . msgs

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Tue Jan 8 02:28:25 MSK 2008


Author: kostix
Date: 2008-01-08 02:28:24 +0300 (Tue, 08 Jan 2008)
New Revision: 86

Added:
   trunk/plugins/customstatus/AUTHORS
   trunk/plugins/customstatus/INSTALL
   trunk/plugins/customstatus/README
   trunk/plugins/customstatus/TODO
   trunk/plugins/customstatus/customstatus.tcl
   trunk/plugins/customstatus/license.terms
   trunk/plugins/customstatus/msgs/
   trunk/plugins/customstatus/msgs/ru.msg
Log:
Imported files for the customstatus plugin.


Added: trunk/plugins/customstatus/AUTHORS
===================================================================
--- trunk/plugins/customstatus/AUTHORS	                        (rev 0)
+++ trunk/plugins/customstatus/AUTHORS	2008-01-07 23:28:24 UTC (rev 86)
@@ -0,0 +1 @@
+Konstantin Khomoutov <flatworm at users.sourceforge.com>


Property changes on: trunk/plugins/customstatus/AUTHORS
___________________________________________________________________
Name: svn:eol-style
   + native

Added: trunk/plugins/customstatus/INSTALL
===================================================================
--- trunk/plugins/customstatus/INSTALL	                        (rev 0)
+++ trunk/plugins/customstatus/INSTALL	2008-01-07 23:28:24 UTC (rev 86)
@@ -0,0 +1,15 @@
+As usually, copy this directory under the ~/.tkabber/plugins directory
+so that you get a hierarchy like this:
+  ~/.tkabber/plugins
+  ~/.tkabber/plugins/customstatus/
+  ~/.tkabber/plugins/customstatus/customstatus.tcl
+
+Restart Tkabber, to get the plugin loaded.
+
+Now you can edit your custom presence statuses and their
+description using the newly added toolbar button.
+Also you can open the presence presets editor using the
+"Tkabber->Plugins->Edit presence presets" main menu item.
+
+Consult the README file for the details about using this plugin.
+


Property changes on: trunk/plugins/customstatus/INSTALL
___________________________________________________________________
Name: svn:eol-style
   + native

Added: trunk/plugins/customstatus/README
===================================================================
--- trunk/plugins/customstatus/README	                        (rev 0)
+++ trunk/plugins/customstatus/README	2008-01-07 23:28:24 UTC (rev 86)
@@ -0,0 +1,12 @@
+$Id$
+"Custom presence statuses" plugin for Tkabber.
+
+I. The idea.
+
+IV. References:
+
+1. http://www.tcl.tk/man/tcl8.4/TkCmd/event.htm
+2. http://www.tcl.tk/man/tcl8.4/TkLib/GetColor.htm
+3. http://www.tcl.tk/man/tcl8.4/TkCmd/colors.htm
+
+vim:et:ts=4:sw=4:tw=64


Property changes on: trunk/plugins/customstatus/README
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/plugins/customstatus/TODO
===================================================================
--- trunk/plugins/customstatus/TODO	                        (rev 0)
+++ trunk/plugins/customstatus/TODO	2008-01-07 23:28:24 UTC (rev 86)
@@ -0,0 +1,26 @@
+$Id$
+
+
+HIGH:
+
+
+* Fill README file.
+
+* Provide for tweaking "options" array via config.tcl
+
+* Extensive testing.
+
+
+LOW:
+
+
+WIBNIs:
+
+
+* Implement "keep desc" or "transparent" or "default"
+  flag for custom status entries which means:
+  "when chosen don't touch the current status description,
+  leave it as is, just change the status".
+  This will allow to integrate "normal" status entries
+  into the custom set.
+


Property changes on: trunk/plugins/customstatus/TODO
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/plugins/customstatus/customstatus.tcl
===================================================================
--- trunk/plugins/customstatus/customstatus.tcl	                        (rev 0)
+++ trunk/plugins/customstatus/customstatus.tcl	2008-01-07 23:28:24 UTC (rev 86)
@@ -0,0 +1,384 @@
+# $Id$
+# "Custom presence statuses" plugin for Tkabber.
+# Written by Konstantin Khomoutov <flatworm at users.sourceforge.net>
+# See licence.terms for the terms of distribution.
+# See README for details.
+
+option add *presencePresetsEditorGeometry    "600x380"    widgetDefault
+
+namespace eval customstatus {
+	# TODO change to "no" when releasing:
+	package require control
+	::control::control assert enabled yes
+	namespace import ::control::assert
+
+	# Load message catalog:
+	package require msgcat
+	::msgcat::mcload [file join [file dir [info script]] msgs]
+
+	# Some hacky options:
+	variable options
+	array set options {
+		subvert_main_presets_menu   no
+		subvert_quick_presets_menu  no
+		add_toolbar_item            yes
+		toolbar_item_image          services/icq/chat
+		accelerate_menus            no
+		extend_quick_presets_panel  yes
+		quick_presets_panel_image   services/icq/chat
+	}
+
+	variable presets
+
+	custom::defgroup CustomStatusPresets \
+		"Custom status presets" \
+		-group Hidden
+
+	custom::defvar presets {} \
+		"Custom status presets" \
+		-group CustomStatusPresets \
+		-type list
+
+	hook::add finload_hook [namespace current]::install
+
+	proc mycommand args {
+		lreplace $args 0 0 [my [lindex $args 0]]
+	}
+
+	proc my thing {
+		return [uplevel 1 namespace current]::$thing
+	}
+}
+
+proc customstatus::install {} {
+	global user_status_list
+	variable options
+	variable presets
+	variable s2d
+
+	array set s2d $user_status_list
+
+	set m [recreate_menu]
+
+	if {$options(add_toolbar_item)} {
+		set n [ifacetk::add_toolbar_button \
+			$options(toolbar_item_image) \
+			[mycommand post_menu $m] \
+			[::msgcat::mc "Presence presets"]]
+
+		set bbox [.mainframe gettoolbar 0].bbox
+		$bbox itemconfigure $n -state disabled
+		proc [namespace current]::toolbar_button_state \
+			{bbox idx state connid} {
+				$bbox itemconfigure $idx -state $state
+		}
+		hook::add connected_hook [mycommand \
+			toolbar_button_state $bbox $n normal]
+		hook::add disconnected_hook [mycommand \
+			toolbar_button_state $bbox $n disabled]
+	}
+
+	set pm [.mainframe getmenu plugins]
+	$pm add command -label [::msgcat::mc "Edit presence presets"] \
+		-command [mycommand edit_presence_presets]
+
+	# HACK! Inserting a new menu item to the menu hierarchy
+	# created by [descmenu] of a MainFrame breaks any keybindings
+	# on the menu items that happen to be lower than the newly
+	# inserted one since that bindings are made to numerical
+	# indices of menu entries.
+	# So if any keybindings will be added below Ctrl-J, this
+	# code will break them:
+	if {$options(subvert_main_presets_menu)} {
+		set pm   [.mainframe getmenu presence]
+		set prio [::msgcat::mc "Change priority..."]
+		set cmd  [$pm entrycget $prio -command]
+
+		set tm [.mainframe getmenu tkabber]
+		set lwr [::msgcat::mc "Log out with reason..."]
+		set ix [expr {[$tm index $lwr] + 1}]
+		$tm insert $ix command \
+			-label $prio -command $cmd
+		set pres [::msgcat::mc "Presence"]
+		$tm entryconfigure $pres -menu $m
+	}
+
+	# HACK! see [rebuild_menu]
+	if {$options(subvert_quick_presets_menu)} {
+		.presence.button configure -menu $m
+	}
+
+	if {$options(extend_quick_presets_panel)} {
+		set b [button .presence.custom \
+			-image $options(quick_presets_panel_image) \
+			-command [mycommand post_menu $m] \
+			-state disabled]
+		pack $b -side left -after .presence.button -anchor w -fill y
+		proc [namespace current]::quick_button_state {b state connid} {
+				$b configure -state $state
+		}
+		hook::add connected_hook [mycommand quick_button_state $b normal]
+		hook::add disconnected_hook [mycommand quick_button_state $b disabled]
+	}
+}
+
+proc customstatus::recreate_menu {} {
+	variable presets
+	variable s2d
+
+	# HACK! This name is chosen to allow subvertion of the
+	# standard "quick presence menu": since .presence.button
+	# is a menubutton widget its menu must be its descendant,
+	# so we do it:
+	set m .presence.button.custom_menu
+	if {[winfo exists $m]} {
+		destroy $m
+	}
+	menu $m
+
+	set accel 0
+	foreach {status msg} $presets {
+		next_accel accel label aidx
+		append label "$s2d($status): "
+		if {[string len $msg] > 25} {
+			append label [string range $msg 0 22] ...
+		} else {
+			append label $msg
+		}
+		$m add command -label $label -underline $aidx \
+			-command [mycommand use $status $msg]
+	}
+
+	$m add separator
+	$m add command -label [::msgcat::mc "Edit presence presets"] \
+		-command [mycommand edit_presence_presets]
+
+	set m
+}
+
+proc customstatus::next_accel {vaccel vprefix vindex} {
+	upvar 1 $vaccel accel $vprefix prefix $vindex index
+	variable options
+
+	if {$options(accelerate_menus) && $accel < 9} {
+		set prefix "[incr accel]. "
+		set index 0
+	} else {
+		set prefix ""
+		set index -1
+	}
+}
+
+proc customstatus::post_menu menu {
+	tk_popup $menu [winfo pointerx .] [winfo pointery .]
+}
+
+proc customstatus::use {status message} {
+	global textstatus userstatus
+
+	set textstatus $message
+	set userstatus $status
+}
+
+proc customstatus::edit_presence_presets {} {
+	global user_status_list
+	variable presets
+	variable editor
+	variable items
+	variable descs
+	variable d2s
+	variable s2d
+
+	set w .presence_status_presets
+	if {[winfo exists $w]} {
+		focus $w
+		return
+	}
+
+	Dialog $w -title [::msgcat::mc "Presence presets editor"] \
+		-modal none -transient no \
+		-separator 1 -anchor e -default 0 -cancel 1
+
+	variable action
+	$w add -text [::msgcat::mc "OK"]     -command [list set [my action] commit]
+	$w add -text [::msgcat::mc "Cancel"] -command [list set [my action] discard]
+
+	bind $w <Destroy> +[mycommand cleanup_state $w %W]
+
+	set if [$w getframe]
+
+	foreach {s d} $user_status_list {
+		switch -- $s { invisible - unavailable continue }
+		set d2s($d) $s
+		set s2d($s) $d
+		lappend descs $d
+	}
+
+	# Items holder:
+	set sw [ScrolledWindow $if.sw -scrollbar vertical]
+	set sf [ScrollableFrame $sw.items -constrainedwidth yes]
+	$sw setwidget $sf
+	set f [$sf getframe]
+
+	# Footer elements:
+	button $if.new -text [::msgcat::mc "Add item"] \
+		-command [mycommand add_preset $f [::msgcat::mc "Available"] ""]
+
+	# Pack them bottom up so that the items holder is packed last:
+	pack $if.new -side bottom -anchor se
+	pack $sw -side bottom -fill both -expand true
+
+	# Now place existing items:
+
+	grid columnconfigure $f 1 -weight 1
+
+	# Column captions:
+	label $f.lpres -text [::msgcat::mc "Presence"]
+	label $f.lmsg  -text [::msgcat::mc "Message"]
+	grid $f.lpres $f.lmsg -sticky w -padx 1m
+
+	# Now goes the content:
+	set items {}
+	set editor(id) 0
+	foreach {s m} $presets {
+		add_preset $f $s2d($s) $m
+	}
+
+	$w draw
+	vwait [my action]
+
+	switch -- $action {
+		commit { commit_changes $w }
+		discard {}
+	}
+	unset action
+
+	destroy $w
+}
+
+proc customstatus::bwidget_dialog_geo_hack w {
+	set x [winfo x $w]
+	set y [winfo y $w]
+
+	set geo [option get . presencePresetsEditorGeometry ""]
+	if {![regexp {^(\d+x\d+).*$} $geo -> sizes]} {
+		return -code error "bad geometry spec: $geo"
+	}
+
+	return $geo+$x+$y
+}
+
+proc customstatus::add_preset {w desc msg} {
+	variable presets
+	variable editor
+	variable descs
+	variable items
+
+	set id $editor(id)
+	lappend items $id
+
+	set editor(desc,$id) $desc
+	set editor(message,$id) $msg
+
+	set 1 [ComboBox $w.desc$id -values $descs \
+		-editable false \
+		-textvariable [my editor(desc,$id)]]
+	set 2 [entry $w.message$id \
+		-textvariable [my editor(message,$id)]]
+	set 3 [button $w.up$id -text [::msgcat::mc "Up"] \
+		-command [mycommand move_up $w $id]]
+	set 4 [button $w.down$id -text [::msgcat::mc "Down"] \
+		-command [mycommand move_down $w $id]]
+	set 5 [button $w.delete$id -text [::msgcat::mc "Delete"] \
+		-command [mycommand delete_preset $w $id]]
+
+	grid $1 $2 $3 $4 $5 -sticky we -padx 1m
+
+	bind $2 <Control-Up> [mycommand move_up $w $id]
+	bind $2 <Control-Down> [mycommand move_down $w $id]
+
+	incr editor(id)
+}
+
+proc customstatus::delete_preset {w id} {
+	variable editor
+	variable items
+
+	destroy $w.desc$id $w.message$id $w.up$id $w.down$id $w.delete$id
+	array unset editor *,$id
+
+	set ix [lsearch -exact -integer $items $id]
+	set items [lreplace $items $ix $ix]
+}
+
+proc customstatus::commit_changes w {
+	variable presets
+	variable editor
+	variable items
+	variable d2s
+
+	set out {}
+	foreach id $items {
+		set status $d2s($editor(desc,$id))
+		lappend out $status $editor(message,$id)
+	}
+
+	set presets $out
+
+	recreate_menu
+}
+
+proc customstatus::cleanup_state {w1 w2} {
+	if {![string equal $w1 $w2]} return
+
+	variable editor
+	array unset editor
+
+	variable items
+	unset items
+
+	variable descs
+	unset descs
+
+	variable d2s
+	array unset d2s
+
+	variable s2d
+	array unset s2d
+}
+
+proc customstatus::move_up {w id} {
+	variable items
+	variable editor
+
+	set a [lsearch -exact -integer $items $id]
+	set b [expr {$a == 0 ? [llength $items] - 1 : $a - 1}]
+
+	exchange $w $a $b
+}
+
+proc customstatus::move_down {w id} {
+	variable items
+	variable editor
+
+	set a [lsearch -exact -integer $items $id]
+	set b [expr {$a == [llength $items] - 1 ? 0 : $a + 1}]
+
+	exchange $w $a $b
+}
+
+proc customstatus::exchange {w 1 2} {
+	variable editor
+
+	foreach field {desc message} {
+		set tmp $editor($field,$1)
+		set editor($field,$1) $editor($field,$2)
+		set editor($field,$2) $tmp
+	}
+
+	# Focus follows moved preset, if possible:
+	if {[regexp ^$w.(desc|message)$1\$ [focus] -> widget]} {
+		focus $w.$widget$2
+	}
+}
+


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

Added: trunk/plugins/customstatus/license.terms
===================================================================
--- trunk/plugins/customstatus/license.terms	                        (rev 0)
+++ trunk/plugins/customstatus/license.terms	2008-01-07 23:28:24 UTC (rev 86)
@@ -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.


Property changes on: trunk/plugins/customstatus/license.terms
___________________________________________________________________
Name: svn:eol-style
   + native

Added: trunk/plugins/customstatus/msgs/ru.msg
===================================================================
--- trunk/plugins/customstatus/msgs/ru.msg	                        (rev 0)
+++ trunk/plugins/customstatus/msgs/ru.msg	2008-01-07 23:28:24 UTC (rev 86)
@@ -0,0 +1,8 @@
+# $Id: ru.msg 123 2007-04-06 00:43:26Z kostix $
+# Russian messages for ../customstatus.tcl
+# vim:enc=utf-8
+::msgcat::mcset ru "Edit presence presets" "Редактировать предустановки присутствия"
+::msgcat::mcset ru "Presence presets" "Предустановки присутствия"
+::msgcat::mcset ru "Presence presets editor" "Редактор предустановок присутствия"
+::msgcat::mcset ru "Status" "Статус"
+


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



More information about the Tkabber-dev mailing list