[Tkabber-dev] r859 - in trunk/tkabber: . ifacetk plugins/general plugins/iq

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Fri Jan 5 15:24:16 MSK 2007


Author: sergei
Date: 2007-01-05 15:24:11 +0300 (Fri, 05 Jan 2007)
New Revision: 859

Added:
   trunk/tkabber/config.tcl
Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/ifacetk/iface.tcl
   trunk/tkabber/plugins/general/autoaway.tcl
   trunk/tkabber/plugins/iq/last.tcl
   trunk/tkabber/splash.tcl
   trunk/tkabber/tkabber.tcl
Log:
	* plugins/general/autoaway.tcl, plugins/iq/last.tcl: Added support
	  of [tk inactive], which works in Tk 8.5.

	* ifacetk/iface.tcl: Added window path to map_window_hook call.

	* ifacetk/iface.tcl, splash.tcl, tkabber.tcl: Added Tcl/Tk version
	  to About and splash windows. Added description of a vew more
	  commands to Quick help window (thanks to Konstantin Khomoutov).

	* config.tcl, tkabber.tcl: Changed config directory in Windows and
	  MacOS. Also, Tkabber now honors TKABBER_HOME environment variable
	  (thanks to Konstantin Khomoutov).


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2007-01-03 15:10:29 UTC (rev 858)
+++ trunk/tkabber/ChangeLog	2007-01-05 12:24:11 UTC (rev 859)
@@ -1,3 +1,18 @@
+2007-01-05  Sergei Golovan  <sgolovan at nes.ru>
+
+	* plugins/general/autoaway.tcl, plugins/iq/last.tcl: Added support
+	  of [tk inactive], which works in Tk 8.5.
+
+	* ifacetk/iface.tcl: Added window path to map_window_hook call.
+
+	* ifacetk/iface.tcl, splash.tcl, tkabber.tcl: Added Tcl/Tk version
+	  to About and splash windows. Added description of a vew more
+	  commands to Quick help window (thanks to Konstantin Khomoutov).
+
+	* config.tcl, tkabber.tcl: Changed config directory in Windows and
+	  MacOS. Also, Tkabber now honors TKABBER_HOME environment variable
+	  (thanks to Konstantin Khomoutov).
+
 2007-01-02  Sergei Golovan  <sgolovan at nes.ru>
 
 	* userinfo.tcl, chats.tcl: Added empty item to comboboxes in show

Added: trunk/tkabber/config.tcl
===================================================================
--- trunk/tkabber/config.tcl	                        (rev 0)
+++ trunk/tkabber/config.tcl	2007-01-05 12:24:11 UTC (rev 859)
@@ -0,0 +1,124 @@
+# $Id$
+# Provides for deducing the location of Tkabber config directory depending
+# on the current platform.
+
+namespace eval config {}
+
+# Deduces the location of the "Application Data" directory
+# (in its wide sense) on the current Windows platform.
+# See: http://ru.tkabber.jabe.ru/index.php/Config_dir
+proc config::appdata_windows {} {
+    global env
+
+    if {[info exists env(APPDATA)]} {
+	return $env(APPDATA)
+    }
+
+    if {![catch {package require registry}]} {
+	set key {HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders}
+	if {![catch {registry get $key AppData} dir]} {
+	    return $dir
+	}
+    }
+
+    return {}
+}
+
+# Copies the contents of dir $from under dir $to using bells'n'whistles.
+# NOTE that at the time of invocation:
+# * $from MUST exist
+# * $to MUST NOT exist.
+# Returns true if copying succeeded, false otherwise.
+proc config::transfer_dir {from to} {
+    set w .configdirtransfer
+
+    Dialog $w -title [::msgcat::mc "Please stand by..."] \
+	-separator 1 -anchor e -default 0 -cancel 0 -modal none
+
+    $w add -text [::msgcat::mc "Close"] \
+	-state disabled \
+	-command [list destroy $w]
+
+    set f [$w getframe]
+
+    pack [message $f.msg -aspect 50000 \
+	-text [::msgcat::mc "Please, be patient while Tkabber\
+	    configuration directory is being transferred\
+	    to the new location"]]
+
+    $w draw
+    grab $w
+    update ;# for win9x (only?)
+
+    set failed [catch {file copy $from $to} err]
+
+    catch {destroy $w}
+    if {$failed} {
+	tk_messageBox -icon error \
+	    -title [::msgcat::mc "Attention"] \
+	    -message [format [::msgcat::mc "Tkabber configuration directory\
+		transfer failed with:\n%s\n\
+		Tkabber will use the old directory:\n%s"] $err $from]
+    } else {
+	set to [file nativename $to]
+	tk_messageBox \
+	    -title [::msgcat::mc "Attention"] \
+	    -message [format \
+		[::msgcat::mc "Your new Tkabber config\
+		    directory is now:\n%s\nYou can delete the old one:\n%s"] \
+		    $to $from]
+    }
+
+    expr {!$failed}
+}
+
+# Based on the current platform, chooses the location of the Tkabber's
+# config dir and sets the "configdir" global variable to its pathname.
+# "TKABBER_HOME" env var overrides any guessing.
+# NOTE that this proc now tries to copy contents of the "old-style"
+# ~/.tkabber config dir to the new location, if needed, to provide
+# smooth upgrade for Tkabber users on Windows.
+# This behaviour should be lifted eventually in the future.
+
+if {![info exists env(TKABBER_HOME)]} {
+    switch -- $tcl_platform(platform) {
+	unix {
+	    set configdir ~/.tkabber
+	}
+	windows {
+	    set dir [config::appdata_windows]
+	    if {$dir != {}} {
+		set configdir [file join $dir Tkabber]
+	    } else {
+	    # Fallback default (depends on Tcl's idea about ~):
+	    set configdir [file join ~ .tkabber]
+	    }
+	}
+	macintosh {
+	    set configdir [file join ~ Library "Application Support" Tkabber]
+	}
+    }
+
+    set env(TKABBER_HOME) $configdir
+} else {
+    set configdir $env(TKABBER_HOME)
+}
+
+if {$tcl_version >= 8.4} {
+    set configdir [file normalize $configdir]
+}
+
+# This should be lifted in the next release after introduction
+# of configdir.
+# TODO: what perms does the dest dir of [file copy] receive?
+# Since it's only needed for Windows, we don't really care now.
+if {![file exists $configdir] && [file isdir ~/.tkabber]} {
+    if {![config::transfer_dir ~/.tkabber $configdir]} {
+	# Transfer error-case fallback:
+	set configdir ~/.tkabber
+    }
+}
+
+file mkdir $configdir
+
+# vim:ts=8:sw=4:sts=4:noet


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

Modified: trunk/tkabber/ifacetk/iface.tcl
===================================================================
--- trunk/tkabber/ifacetk/iface.tcl	2007-01-03 15:10:29 UTC (rev 858)
+++ trunk/tkabber/ifacetk/iface.tcl	2007-01-05 12:24:11 UTC (rev 859)
@@ -410,25 +410,27 @@
     $::tk_modify-L\t\t\t[::msgcat::mc {Log in}]
     $::tk_modify-J\t\t\t[::msgcat::mc {Log out}]
 \n[::msgcat::mc Tabs:]
-    $::tk_modify-F4\t\t\t[::msgcat::mc {Close tab}]
+    $::tk_modify-F4,
+    [::msgcat::mc {Middle mouse button}]\t[::msgcat::mc {Close tab}]
     $::tk_modify-PgUp/Down\t\t[::msgcat::mc {Previous/Next tab}]
     $::tk_modify-Alt-PgUp/Down\t[::msgcat::mc {Move tab left/right}]
     Alt-\[1-9,0\]\t\t[::msgcat::mc {Switch to tab number 1-9,10}]
     $::tk_modify-R\t\t\t[::msgcat::mc {Hide/Show roster}]
+\n[::msgcat::mc Common:]
+    $::tk_modify-S\t\t\t[::msgcat::mc {Activate search panel}]
 \n[::msgcat::mc Chats:]
-    TAB\t\t\t[::msgcat::mc {Complete nickname}]
+    TAB\t\t\t[::msgcat::mc {Complete nicknames and /commands}]
     $::tk_modify-Up/Down\t\t[::msgcat::mc {Previous/Next history message}]
-    Alt-E\t\t\t[::msgcat::mc {Show emoticons}]
+    Alt-E\t\t\t[::msgcat::mc {Show palette of emoticons}]
     $::tk_modify-Z\t\t\t[::msgcat::mc {Undo}]
     $::tk_modify-Shift-Z\t\t[::msgcat::mc {Redo}]
     Alt-PgUp/Down\t\t[::msgcat::mc {Scroll chat window up/down}]
-    $::tk_modify-S\t\t\t[::msgcat::mc {Search in chat window}]
     [::msgcat::mc {Right mouse button}]\t[::msgcat::mc {Correct word}]
 "
 }
 
 proc ifacetk::about_window {} {
-    global version
+    global version toolkit_version
 
     help_window [::msgcat::mc "About"] "
 Tkabber $version
@@ -440,7 +442,10 @@
     [::msgcat::mc {Sergei Golovan}]
     [::msgcat::mc {Michail Litvak}]
 
-http://tkabber.jabber.ru/"
+http://tkabber.jabber.ru/
+
+[::msgcat::mc {Uses:}] $toolkit_version\
+"
 }
 
 proc ifacetk::help_window {title message} {
@@ -449,7 +454,7 @@
     .m add -text [::msgcat::mc "Close"]
     set frame [.m getframe]
     message $frame.msg -text $message
-    pack $frame.msg -side left
+    pack $frame.msg -side left -fill both -expand true
     .m draw
     destroy .m
 }
@@ -802,7 +807,7 @@
 	}
     }
 
-    bind . <Map> [list hook::run map_window_hook .]
+    bind . <Map> [list hook::run map_window_hook %W]
 
     wm geometry . $geometry
 

Modified: trunk/tkabber/plugins/general/autoaway.tcl
===================================================================
--- trunk/tkabber/plugins/general/autoaway.tcl	2007-01-03 15:10:29 UTC (rev 858)
+++ trunk/tkabber/plugins/general/autoaway.tcl	2007-01-05 12:24:11 UTC (rev 859)
@@ -12,50 +12,54 @@
     global tcl_platform
     global idle_command
 
-    switch -- $tcl_platform(platform) {
-        macintosh {
-	    set idle_command [namespace current]::AquaIdleTime
-	}
+    if {[catch {tk inactive}] || ([tk inactive] < 0)} {
+	switch -- $tcl_platform(platform) {
+	    macintosh {
+		set idle_command [namespace current]::AquaIdleTime
+	    }
 
-	unix {
-	    if {$::aquaP} {
-	        set idle_command [namespace current]::AquaIdleTime
-	    } elseif {[catch { package require tkXwin }]} {
-		return
-	    } else {
-	        set idle_command tkXwin::idletime
+	    unix {
+		if {$::aquaP} {
+		    set idle_command [namespace current]::AquaIdleTime
+		} elseif {[catch { package require tkXwin }]} {
+		    return
+		} else {
+		    set idle_command tkXwin::idletime
+		}
 	    }
-	}
-	windows {
-	    if {[catch { package require tclWinidle }]} {
+	    windows {
+		if {[catch { package require tclWinidle }]} {
+		    return
+		}
+		set idle_command tclWinidle::idletime
+	    }
+	    default {
 		return
 	    }
-	    set idle_command tclWinidle::idletime
 	}
-	default {
-	    return
-	}
+    } else {
+	set idle_command {tk inactive}
     }
 
     custom::defgroup AutoAway \
 	[::msgcat::mc "Options for module that automatically marks\
-you as away after idle threshold."] \
+		       you as away after idle threshold."] \
 	-group Tkabber
 
     custom::defvar options(awaytime) 5 \
 	[::msgcat::mc "Idle threshold in minutes after that\
-Tkabber marks you as away."] \
+		       Tkabber marks you as away."] \
 	-group AutoAway -type integer
 
     custom::defvar options(xatime) 15 \
 	[::msgcat::mc "Idle threshold in minutes after that\
-Tkabber marks you as extended away."] \
+		       Tkabber marks you as extended away."] \
 	-group AutoAway -type integer
 
     custom::defvar options(status) \
 	[::msgcat::mc "Automatically away due to idle"] \
 	[::msgcat::mc "Text status, which is set when\
-Tkabber is moving to away state."] \
+		       Tkabber is moving to away state."] \
 	-group AutoAway -type string
 
     custom::defvar options(drop_priority) 1 \
@@ -97,7 +101,9 @@
         return
     }
 
-    if {[set idletime [$idle_command]] < [expr {$options(awaytime)*60*1000}]} {
+    set idletime [eval $idle_command]
+
+    if {$idletime < [expr {$options(awaytime)*60*1000}]} {
         if {![cequal $savestatus ""]} {
 	    if {$options(drop_priority) && ($userpriority >= 0)} {
 		set userpriority $savepriority

Modified: trunk/tkabber/plugins/iq/last.tcl
===================================================================
--- trunk/tkabber/plugins/iq/last.tcl	2007-01-03 15:10:29 UTC (rev 858)
+++ trunk/tkabber/plugins/iq/last.tcl	2007-01-05 12:24:11 UTC (rev 859)
@@ -12,7 +12,7 @@
     jlib::wrapper:splitxml $child tag vars isempty chdata children
 
     if {$options(reply_iq_last) && [info exists idle_command]} {
-	set seconds [expr {[$idle_command]/1000}]
+	set seconds [expr {[eval $idle_command]/1000}]
 	set status $statusdesc($userstatus)
 	if {[cequal $textstatus ""]} {
 	    set status "$statusdesc($userstatus) ($userstatus)"

Modified: trunk/tkabber/splash.tcl
===================================================================
--- trunk/tkabber/splash.tcl	2007-01-03 15:10:29 UTC (rev 858)
+++ trunk/tkabber/splash.tcl	2007-01-05 12:24:11 UTC (rev 859)
@@ -21,7 +21,7 @@
 
 proc splash_start {{aboutP 0}} {
     global splash_count splash_image splash_info splash_max splash_text
-    global version
+    global version toolkit_version
 
     set splash_info   ""
     set splash_count   0
@@ -130,8 +130,11 @@
     [::msgcat::mc {Sergei Golovan}]
     [::msgcat::mc {Michail Litvak}]
 
-http://tkabber.jabber.ru/"
+http://tkabber.jabber.ru/
 
+[::msgcat::mc {Uses:}] $toolkit_version\
+"
+
     grid $w.frame.image -row 0 -column 0 -sticky w
     grid $w.frame.msg   -row 0 -column 1 -sticky e -padx 10m -pady 5m
 
@@ -232,3 +235,4 @@
 
 splash_start
 
+# vim:ts=8:sw=4:sts=4:noet

Modified: trunk/tkabber/tkabber.tcl
===================================================================
--- trunk/tkabber/tkabber.tcl	2007-01-03 15:10:29 UTC (rev 858)
+++ trunk/tkabber/tkabber.tcl	2007-01-05 12:24:11 UTC (rev 859)
@@ -54,14 +54,15 @@
 
 tk appname tkabber
 
-if {[package provide starkit] != ""} {
+set is_a_starkit [expr {[package provide starkit] != ""}]
+if {$is_a_starkit} {
     set rootdir [file join $::starkit::topdir tkabber]
 } else {
     set rootdir [file dirname [info script]]
 }
 
-set configdir [file join ~ .tkabber]
-catch {set configdir [file normalize $configdir]}
+source config.tcl
+# from now on Tkabber config directory should be referenced via $::configdir
 
 proc get_snapshot {changelog} {
     set snapshot ""
@@ -80,6 +81,9 @@
 
 set version "0.9.9-alpha[get_snapshot [file join $rootdir ChangeLog]]"
 set toolkit_version "Tcl/Tk [info patchlevel]"
+if {$is_a_starkit} {
+    append toolkit_version " (starkit)"
+}
 set debug_lvls {}
 
 proc debugmsg {level msg} {
@@ -272,3 +276,4 @@
 
 hook::run finload_hook
 
+# vim:ts=8:sw=4:sts=4:noet



More information about the Tkabber-dev mailing list