[Tkabber-dev] r393 - in trunk/plugins/vimage: . libary libary/base64 msgs pixmaps

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Sep 19 21:57:46 MSD 2010


Author: Rejjin
Date: 2010-09-19 21:57:46 +0400 (Sun, 19 Sep 2010)
New Revision: 393

Added:
   trunk/plugins/vimage/README
   trunk/plugins/vimage/libary/
   trunk/plugins/vimage/libary/base64/
   trunk/plugins/vimage/libary/base64/base64.tcl
   trunk/plugins/vimage/libary/base64/base64c.tcl
   trunk/plugins/vimage/libary/base64/pkgIndex.tcl
   trunk/plugins/vimage/libary/base64/uuencode.tcl
   trunk/plugins/vimage/libary/base64/yencode.tcl
   trunk/plugins/vimage/pixmaps/
   trunk/plugins/vimage/pixmaps/big.gif
   trunk/plugins/vimage/pixmaps/none.gif
Removed:
   trunk/plugins/vimage/images/
   trunk/plugins/vimage/readme.ru
Modified:
   trunk/plugins/vimage/msgs/ru.msg
   trunk/plugins/vimage/vimage.tcl
Log:
See README for detals.

Added: trunk/plugins/vimage/README
===================================================================
--- trunk/plugins/vimage/README	                        (rev 0)
+++ trunk/plugins/vimage/README	2010-09-19 17:57:46 UTC (rev 393)
@@ -0,0 +1,73 @@
+"Vimage" -- plugin for Tkabber.
+
+
+Usage.
+	This plugin created in order not to run once more browser 
+	to view images. If the plugin is configured accordingly, the 
+	image will be automatically downloaded when a new message 
+	has a link to the picture. If enabled, color schemes, the von 
+	links will change depending on the state. Download pictures 
+	automatically show (if the option is included). If you choose 
+	to disable the automatic download, then you will be able to 
+	view a picture by right-clicking on the link and selecting the 
+	appropriate menu item. The menu contains items for 
+	displaying images to reload image and to display 
+	images without size restrictions. When viewing 
+	images you can click the right mouse button and see 
+	the menu. This menu has items: save the image, return 
+	to Tkabber and a menu where you can zoom in or zoom 
+	out image.
+	If you send a link to the image you have already 
+	downloaded, the download will not be repeated.
+
+	
+Setting (Plugins::Vimage options).
+
+	active_is_message:
+		if enabled options(active_is_message), then Tkabber
+		automatically downloads the image if the reference
+		to it was in the message body.
+		
+	options(auto_show_image):
+		This option enable automatically opens a window viewing
+		pictures after the download.
+		
+	options(use_colors):
+		if this option is enabled, the link works with this plugin 
+		change color of their background.
+		Downloading - a gray background.
+		Download the picture contains an error - red background.
+		Image exceeds the limit - red background.
+		Download image does not contain 
+		errors and do not exceed the limit - green background.
+
+	options(activate_tkabber):
+		Activates the window Tkabber after download ending.
+
+	options(max_size):
+		Limits the maximum size of content (picture).
+		Value indicated in kb.
+		
+	The following options may be absent in some 
+	implementations of Tk!
+
+	options(topmost):
+		View window on top.
+		The option is valid on all windows.
+		
+	options(toolwindow):
+		New style box of window with image.
+
+	
+TODO.
+
+	1) Integration of images in the chat.
+	2) Show progressbar of status download images.
+	3) Accurate and rapid mutations both size images.
+	
+	
+AUTHOR.
+
+	The plugin was written by Rejjin.
+	xmpp:rejjin at jabber.dk
+	e-mail:webrenji at gmail.com
\ No newline at end of file

Added: trunk/plugins/vimage/libary/base64/base64.tcl
===================================================================
--- trunk/plugins/vimage/libary/base64/base64.tcl	                        (rev 0)
+++ trunk/plugins/vimage/libary/base64/base64.tcl	2010-09-19 17:57:46 UTC (rev 393)
@@ -0,0 +1,326 @@
+# base64.tcl --
+#
+# Encode/Decode base64 for a string
+# Stephen Uhler / Brent Welch (c) 1997 Sun Microsystems
+# The decoder was done for exmh by Chris Garrigues
+#
+# Copyright (c) 1998-2000 by Ajuba Solutions.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# 
+# RCS: @(#) $Id: base64.tcl,v 1.27 2005/12/09 18:27:15 andreas_kupries Exp $
+
+# Version 1.0   implemented Base64_Encode, Base64_Decode
+# Version 2.0   uses the base64 namespace
+# Version 2.1   fixes various decode bugs and adds options to encode
+# Version 2.2   is much faster, Tcl8.0 compatible
+# Version 2.2.1 bugfixes
+# Version 2.2.2 bugfixes
+# Version 2.3   bugfixes and extended to support Trf
+
+# @mdgen EXCLUDE: base64c.tcl
+
+package require Tcl 8.2
+namespace eval ::base64 {
+    namespace export encode decode
+}
+
+if {![catch {package require Trf 2.0}]} {
+    # Trf is available, so implement the functionality provided here
+    # in terms of calls to Trf for speed.
+
+    # ::base64::encode --
+    #
+    #	Base64 encode a given string.
+    #
+    # Arguments:
+    #	args	?-maxlen maxlen? ?-wrapchar wrapchar? string
+    #	
+    #		If maxlen is 0, the output is not wrapped.
+    #
+    # Results:
+    #	A Base64 encoded version of $string, wrapped at $maxlen characters
+    #	by $wrapchar.
+    
+    proc ::base64::encode {args} {
+	# Set the default wrapchar and maximum line length to match the output
+	# of GNU uuencode 4.2.  Various RFCs allow for different wrapping 
+	# characters and wraplengths, so these may be overridden by command line
+	# options.
+	set wrapchar "\n"
+	set maxlen 60
+
+	if { [llength $args] == 0 } {
+	    error "wrong # args: should be \"[lindex [info level 0] 0]\
+		    ?-maxlen maxlen? ?-wrapchar wrapchar? string\""
+	}
+
+	set optionStrings [list "-maxlen" "-wrapchar"]
+	for {set i 0} {$i < [llength $args] - 1} {incr i} {
+	    set arg [lindex $args $i]
+	    set index [lsearch -glob $optionStrings "${arg}*"]
+	    if { $index == -1 } {
+		error "unknown option \"$arg\": must be -maxlen or -wrapchar"
+	    }
+	    incr i
+	    if { $i >= [llength $args] - 1 } {
+		error "value for \"$arg\" missing"
+	    }
+	    set val [lindex $args $i]
+
+	    # The name of the variable to assign the value to is extracted
+	    # from the list of known options, all of which have an
+	    # associated variable of the same name as the option without
+	    # a leading "-". The [string range] command is used to strip
+	    # of the leading "-" from the name of the option.
+	    #
+	    # FRINK: nocheck
+	    set [string range [lindex $optionStrings $index] 1 end] $val
+	}
+    
+	# [string is] requires Tcl8.2; this works with 8.0 too
+	if {[catch {expr {$maxlen % 2}}]} {
+	    error "expected integer but got \"$maxlen\""
+	}
+
+	set string [lindex $args end]
+	set result [::base64 -mode encode -- $string]
+	set result [string map [list \n ""] $result]
+
+	if {$maxlen > 0} {
+	    set res ""
+	    set edge [expr {$maxlen - 1}]
+	    while {[string length $result] > $maxlen} {
+		append res [string range $result 0 $edge]$wrapchar
+		set result [string range $result $maxlen end]
+	    }
+	    if {[string length $result] > 0} {
+		append res $result
+	    }
+	    set result $res
+	}
+
+	return $result
+    }
+
+    # ::base64::decode --
+    #
+    #	Base64 decode a given string.
+    #
+    # Arguments:
+    #	string	The string to decode.  Characters not in the base64
+    #		alphabet are ignored (e.g., newlines)
+    #
+    # Results:
+    #	The decoded value.
+
+    proc ::base64::decode {string} {
+	regsub -all {\s} $string {} string
+	::base64 -mode decode -- $string
+    }
+
+} else {
+    # Without Trf use a pure tcl implementation
+
+    namespace eval base64 {
+	variable base64 {}
+	variable base64_en {}
+
+	# We create the auxiliary array base64_tmp, it will be unset later.
+
+	set i 0
+	foreach char {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z \
+		a b c d e f g h i j k l m n o p q r s t u v w x y z \
+		0 1 2 3 4 5 6 7 8 9 + /} {
+	    set base64_tmp($char) $i
+	    lappend base64_en $char
+	    incr i
+	}
+
+	#
+	# Create base64 as list: to code for instance C<->3, specify
+	# that [lindex $base64 67] be 3 (C is 67 in ascii); non-coded
+	# ascii chars get a {}. we later use the fact that lindex on a
+	# non-existing index returns {}, and that [expr {} < 0] is true
+	#
+
+	# the last ascii char is 'z'
+	scan z %c len
+	for {set i 0} {$i <= $len} {incr i} {
+	    set char [format %c $i]
+	    set val {}
+	    if {[info exists base64_tmp($char)]} {
+		set val $base64_tmp($char)
+	    } else {
+		set val {}
+	    }
+	    lappend base64 $val
+	}
+
+	# code the character "=" as -1; used to signal end of message
+	scan = %c i
+	set base64 [lreplace $base64 $i $i -1]
+
+	# remove unneeded variables
+	unset base64_tmp i char len val
+
+	namespace export encode decode
+    }
+
+    # ::base64::encode --
+    #
+    #	Base64 encode a given string.
+    #
+    # Arguments:
+    #	args	?-maxlen maxlen? ?-wrapchar wrapchar? string
+    #	
+    #		If maxlen is 0, the output is not wrapped.
+    #
+    # Results:
+    #	A Base64 encoded version of $string, wrapped at $maxlen characters
+    #	by $wrapchar.
+    
+    proc ::base64::encode {args} {
+	set base64_en $::base64::base64_en
+	
+	# Set the default wrapchar and maximum line length to match the output
+	# of GNU uuencode 4.2.  Various RFCs allow for different wrapping 
+	# characters and wraplengths, so these may be overridden by command line
+	# options.
+	set wrapchar "\n"
+	set maxlen 60
+
+	if { [llength $args] == 0 } {
+	    error "wrong # args: should be \"[lindex [info level 0] 0]\
+		    ?-maxlen maxlen? ?-wrapchar wrapchar? string\""
+	}
+
+	set optionStrings [list "-maxlen" "-wrapchar"]
+	for {set i 0} {$i < [llength $args] - 1} {incr i} {
+	    set arg [lindex $args $i]
+	    set index [lsearch -glob $optionStrings "${arg}*"]
+	    if { $index == -1 } {
+		error "unknown option \"$arg\": must be -maxlen or -wrapchar"
+	    }
+	    incr i
+	    if { $i >= [llength $args] - 1 } {
+		error "value for \"$arg\" missing"
+	    }
+	    set val [lindex $args $i]
+
+	    # The name of the variable to assign the value to is extracted
+	    # from the list of known options, all of which have an
+	    # associated variable of the same name as the option without
+	    # a leading "-". The [string range] command is used to strip
+	    # of the leading "-" from the name of the option.
+	    #
+	    # FRINK: nocheck
+	    set [string range [lindex $optionStrings $index] 1 end] $val
+	}
+    
+	# [string is] requires Tcl8.2; this works with 8.0 too
+	if {[catch {expr {$maxlen % 2}}]} {
+	    error "expected integer but got \"$maxlen\""
+	}
+
+	set string [lindex $args end]
+
+	set result {}
+	set state 0
+	set length 0
+
+
+	# Process the input bytes 3-by-3
+
+	binary scan $string c* X
+	foreach {x y z} $X {
+	    # Do the line length check before appending so that we don't get an
+	    # extra newline if the output is a multiple of $maxlen chars long.
+	    if {$maxlen && $length >= $maxlen} {
+		append result $wrapchar
+		set length 0
+	    }
+	
+	    append result [lindex $base64_en [expr {($x >>2) & 0x3F}]] 
+	    if {$y != {}} {
+		append result [lindex $base64_en [expr {(($x << 4) & 0x30) | (($y >> 4) & 0xF)}]] 
+		if {$z != {}} {
+		    append result \
+			    [lindex $base64_en [expr {(($y << 2) & 0x3C) | (($z >> 6) & 0x3)}]]
+		    append result [lindex $base64_en [expr {($z & 0x3F)}]]
+		} else {
+		    set state 2
+		    break
+		}
+	    } else {
+		set state 1
+		break
+	    }
+	    incr length 4
+	}
+	if {$state == 1} {
+	    append result [lindex $base64_en [expr {(($x << 4) & 0x30)}]]== 
+	} elseif {$state == 2} {
+	    append result [lindex $base64_en [expr {(($y << 2) & 0x3C)}]]=  
+	}
+	return $result
+    }
+
+    # ::base64::decode --
+    #
+    #	Base64 decode a given string.
+    #
+    # Arguments:
+    #	string	The string to decode.  Characters not in the base64
+    #		alphabet are ignored (e.g., newlines)
+    #
+    # Results:
+    #	The decoded value.
+
+    proc ::base64::decode {string} {
+	if {[string length $string] == 0} {return ""}
+
+	set base64 $::base64::base64
+	set output "" ; # Fix for [Bug 821126]
+
+	binary scan $string c* X
+	foreach x $X {
+	    set bits [lindex $base64 $x]
+	    if {$bits >= 0} {
+		if {[llength [lappend nums $bits]] == 4} {
+		    foreach {v w z y} $nums break
+		    set a [expr {($v << 2) | ($w >> 4)}]
+		    set b [expr {(($w & 0xF) << 4) | ($z >> 2)}]
+		    set c [expr {(($z & 0x3) << 6) | $y}]
+		    append output [binary format ccc $a $b $c]
+		    set nums {}
+		}		
+	    } elseif {$bits == -1} {
+		# = indicates end of data.  Output whatever chars are left.
+		# The encoding algorithm dictates that we can only have 1 or 2
+		# padding characters.  If x=={}, we have 12 bits of input 
+		# (enough for 1 8-bit output).  If x!={}, we have 18 bits of
+		# input (enough for 2 8-bit outputs).
+		
+		foreach {v w z} $nums break
+		set a [expr {($v << 2) | (($w & 0x30) >> 4)}]
+		if {$z == {}} {
+		    append output [binary format c $a ]
+		} else {
+		    set b [expr {(($w & 0xF) << 4) | (($z & 0x3C) >> 2)}]
+		    append output [binary format cc $a $b]
+		}		
+		break
+	    } else {
+		# RFC 2045 says that line breaks and other characters not part
+		# of the Base64 alphabet must be ignored, and that the decoder
+		# can optionally emit a warning or reject the message.  We opt
+		# not to do so, but to just ignore the character. 
+		continue
+	    }
+	}
+	return $output
+    }
+}
+
+package provide base64 2.3.2

Added: trunk/plugins/vimage/libary/base64/base64c.tcl
===================================================================
--- trunk/plugins/vimage/libary/base64/base64c.tcl	                        (rev 0)
+++ trunk/plugins/vimage/libary/base64/base64c.tcl	2010-09-19 17:57:46 UTC (rev 393)
@@ -0,0 +1,18 @@
+# base64c - Copyright (C) 2003 Pat Thoyts <patthoyts at users.sourceforge.net>
+#
+# This package is a place-holder for the critcl enhanced code present in
+# the tcllib base64 module.
+#
+# Normally this code will become part of the tcllibc library.
+#
+
+package require critcl
+package provide base64c 0.1.0
+
+namespace eval ::base64c {
+    variable base64c_rcsid {$Id: base64c.tcl,v 1.4 2006/11/04 15:20:36 patthoyts Exp $}
+
+    critcl::ccode {
+        /* no code required in this file */
+    }
+}

Added: trunk/plugins/vimage/libary/base64/pkgIndex.tcl
===================================================================
--- trunk/plugins/vimage/libary/base64/pkgIndex.tcl	                        (rev 0)
+++ trunk/plugins/vimage/libary/base64/pkgIndex.tcl	2010-09-19 17:57:46 UTC (rev 393)
@@ -0,0 +1,4 @@
+if {![package vsatisfies [package provide Tcl] 8.2]} {return}
+package ifneeded base64   2.3.2 [list source [file join $dir base64.tcl]]
+package ifneeded uuencode 1.1.4 [list source [file join $dir uuencode.tcl]]
+package ifneeded yencode  1.1.1 [list source [file join $dir yencode.tcl]]

Added: trunk/plugins/vimage/libary/base64/uuencode.tcl
===================================================================
--- trunk/plugins/vimage/libary/base64/uuencode.tcl	                        (rev 0)
+++ trunk/plugins/vimage/libary/base64/uuencode.tcl	2010-09-19 17:57:46 UTC (rev 393)
@@ -0,0 +1,346 @@
+# uuencode - Copyright (C) 2002 Pat Thoyts <patthoyts at users.sourceforge.net>
+#
+# Provide a Tcl only implementation of uuencode and uudecode.
+#
+# -------------------------------------------------------------------------
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# -------------------------------------------------------------------------
+# @(#)$Id: uuencode.tcl,v 1.21 2006/10/14 06:30:55 andreas_kupries Exp $
+
+package require Tcl 8.2;                # tcl minimum version
+
+# Try and get some compiled helper package.
+if {[catch {package require tcllibc}]} {
+    catch {package require Trf}
+}
+
+namespace eval ::uuencode {
+    variable version 1.1.4
+
+    namespace export encode decode uuencode uudecode
+}
+
+proc ::uuencode::Enc {c} {
+    return [format %c [expr {($c != 0) ? (($c & 0x3f) + 0x20) : 0x60}]]
+}
+
+proc ::uuencode::Encode {s} {
+    set r {}
+    binary scan $s c* d
+    foreach {c1 c2 c3} $d {
+        if {$c1 == {}} {set c1 0}
+        if {$c2 == {}} {set c2 0}
+        if {$c3 == {}} {set c3 0}
+        append r [Enc [expr {$c1 >> 2}]]
+        append r [Enc [expr {(($c1 << 4) & 060) | (($c2 >> 4) & 017)}]]
+        append r [Enc [expr {(($c2 << 2) & 074) | (($c3 >> 6) & 003)}]]
+        append r [Enc [expr {($c3 & 077)}]]
+    }
+    return $r
+}
+
+
+proc ::uuencode::Decode {s} {
+    if {[string length $s] == 0} {return ""}
+    set r {}
+    binary scan [pad $s] c* d
+        
+    foreach {c0 c1 c2 c3} $d {
+        append r [format %c [expr {((($c0-0x20)&0x3F) << 2) & 0xFF
+                                   | ((($c1-0x20)&0x3F) >> 4) & 0xFF}]]
+        append r [format %c [expr {((($c1-0x20)&0x3F) << 4) & 0xFF
+                                   | ((($c2-0x20)&0x3F) >> 2) & 0xFF}]]
+        append r [format %c [expr {((($c2-0x20)&0x3F) << 6) & 0xFF
+                                   | (($c3-0x20)&0x3F) & 0xFF}]]
+    }
+    return $r
+}
+
+# -------------------------------------------------------------------------
+# C coded version of the Encode/Decode functions for base64c package.
+# -------------------------------------------------------------------------
+if {[package provide critcl] != {}} {
+    namespace eval ::uuencode {
+        critcl::ccode {
+            #include <string.h>
+            static unsigned char Enc(unsigned char c) {
+                return (c != 0) ? ((c & 0x3f) + 0x20) : 0x60;
+            }
+        }
+        critcl::ccommand CEncode {dummy interp objc objv} {
+            Tcl_Obj *inputPtr, *resultPtr;
+            int len, rlen, xtra;
+            unsigned char *input, *p, *r;
+            
+            if (objc !=  2) {
+                Tcl_WrongNumArgs(interp, 1, objv, "data");
+                return TCL_ERROR;
+            }
+            
+            inputPtr = objv[1];
+            input = Tcl_GetByteArrayFromObj(inputPtr, &len);
+            if ((xtra = (3 - (len % 3))) != 3) {
+                if (Tcl_IsShared(inputPtr))
+                    inputPtr = Tcl_DuplicateObj(inputPtr);
+                input = Tcl_SetByteArrayLength(inputPtr, len + xtra);
+                memset(input + len, 0, xtra);
+                len += xtra;
+            }
+
+            rlen = (len / 3) * 4;
+            resultPtr = Tcl_GetObjResult(interp);
+            if (Tcl_IsShared(resultPtr)) {
+                resultPtr = Tcl_DuplicateObj(resultPtr);
+                Tcl_SetObjResult(interp, resultPtr);
+            }
+            r = Tcl_SetByteArrayLength(resultPtr, rlen);
+            memset(r, 0, rlen);
+            
+            for (p = input; p < input + len; p += 3) {
+                char a, b, c;
+                a = *p; b = *(p+1), c = *(p+2);
+                *r++ = Enc(a >> 2);
+                *r++ = Enc(((a << 4) & 060) | ((b >> 4) & 017));
+                *r++ = Enc(((b << 2) & 074) | ((c >> 6) & 003));
+                *r++ = Enc(c & 077);
+            }
+            
+            return TCL_OK;
+        }
+
+        critcl::ccommand CDecode {dummy interp objc objv} {
+            Tcl_Obj *inputPtr, *resultPtr;
+            int len, rlen, xtra;
+            unsigned char *input, *p, *r;
+            
+            if (objc !=  2) {
+                Tcl_WrongNumArgs(interp, 1, objv, "data");
+                return TCL_ERROR;
+            }
+            
+            /* if input is not mod 4, extend it with nuls */
+            inputPtr = objv[1];
+            input = Tcl_GetByteArrayFromObj(inputPtr, &len);
+            if ((xtra = (4 - (len % 4))) != 4) {
+                if (Tcl_IsShared(inputPtr))
+                    inputPtr = Tcl_DuplicateObj(inputPtr);
+                input = Tcl_SetByteArrayLength(inputPtr, len + xtra);
+                memset(input + len, 0, xtra);
+                len += xtra;
+            }
+
+            /* output will be 1/3 smaller than input and a multiple of 3 */
+            rlen = (len / 4) * 3;
+            resultPtr = Tcl_GetObjResult(interp);
+            if (Tcl_IsShared(resultPtr)) {
+                resultPtr = Tcl_DuplicateObj(resultPtr);
+                Tcl_SetObjResult(interp, resultPtr);
+            }
+            r = Tcl_SetByteArrayLength(resultPtr, rlen);
+            memset(r, 0, rlen);
+            
+            for (p = input; p < input + len; p += 4) {
+                char a, b, c, d;
+                a = *p; b = *(p+1), c = *(p+2), d = *(p+3);
+                *r++ = (((a - 0x20) & 0x3f) << 2) | (((b - 0x20) & 0x3f) >> 4);
+                *r++ = (((b - 0x20) & 0x3f) << 4) | (((c - 0x20) & 0x3f) >> 2);
+                *r++ = (((c - 0x20) & 0x3f) << 6) | (((d - 0x20) & 0x3f) );
+            }
+            
+            return TCL_OK;
+        }
+    }
+}
+
+# -------------------------------------------------------------------------
+
+# Description:
+#  Permit more tolerant decoding of invalid input strings by padding to
+#  a multiple of 4 bytes with nulls.
+# Result:
+#  Returns the input string - possibly padded with uuencoded null chars.
+#
+proc ::uuencode::pad {s} {
+    if {[set mod [expr {[string length $s] % 4}]] != 0} {
+        append s [string repeat "`" [expr {4 - $mod}]]
+    }
+    return $s
+}
+
+# -------------------------------------------------------------------------
+
+# If the Trf package is available then we shall use this by default but the
+# Tcllib implementations are always visible if needed (ie: for testing)
+if {[info command ::uuencode::CDecode] != {}} {    
+    # tcllib critcl package
+    interp alias {} ::uuencode::encode {} ::uuencode::CEncode
+    interp alias {} ::uuencode::decode {} ::uuencode::CDecode
+} elseif {[package provide Trf] != {}} {
+    proc ::uuencode::encode {s} {
+        return [::uuencode -mode encode -- $s]
+    }
+    proc ::uuencode::decode {s} {
+        return [::uuencode -mode decode -- [pad $s]]
+    }
+} else {
+    # pure-tcl then
+    interp alias {} ::uuencode::encode {} ::uuencode::Encode
+    interp alias {} ::uuencode::decode {} ::uuencode::Decode
+}
+
+# -------------------------------------------------------------------------
+
+proc ::uuencode::uuencode {args} {
+    array set opts {mode 0644 filename {} name {}}
+    set wrongargs "wrong \# args: should be\
+            \"uuencode ?-name string? ?-mode octal?\
+            (-file filename | ?--? string)\""
+    while {[string match -* [lindex $args 0]]} {
+        switch -glob -- [lindex $args 0] {
+            -f* {
+                if {[llength $args] < 2} {
+                    return -code error $wrongargs
+                }
+                set opts(filename) [lindex $args 1]
+                set args [lreplace $args 0 0]
+            }
+            -m* {
+                if {[llength $args] < 2} {
+                    return -code error $wrongargs
+                }
+                set opts(mode) [lindex $args 1]
+                set args [lreplace $args 0 0]
+            }
+            -n* {
+                if {[llength $args] < 2} {
+                    return -code error $wrongargs
+                }
+                set opts(name) [lindex $args 1]
+                set args [lreplace $args 0 0]
+            }
+            -- {
+                set args [lreplace $args 0 0]
+                break
+            }
+            default {
+                return -code error "bad option [lindex $args 0]:\
+                      must be -file, -mode, or -name"
+            }
+        }
+        set args [lreplace $args 0 0]
+    }
+
+    if {$opts(name) == {}} {
+        set opts(name) $opts(filename)
+    }
+    if {$opts(name) == {}} {
+        set opts(name) "data.dat"
+    }
+
+    if {$opts(filename) != {}} {
+        set f [open $opts(filename) r]
+        fconfigure $f -translation binary
+        set data [read $f]
+        close $f
+    } else {
+        if {[llength $args] != 1} {
+            return -code error $wrongargs
+        }
+        set data [lindex $args 0]
+    }
+
+    set r {}
+    append r [format "begin %o %s" $opts(mode) $opts(name)] "\n"
+    for {set n 0} {$n < [string length $data]} {incr n 45} {
+        set s [string range $data $n [expr {$n + 44}]]
+        append r [Enc [string length $s]]
+        append r [encode $s] "\n"
+    }
+    append r "`\nend"
+    return $r
+}
+
+# -------------------------------------------------------------------------
+# Description:
+#  Perform uudecoding of a file or data. A file may contain more than one
+#  encoded data section so the result is a list where each element is a 
+#  three element list of the provided filename, the suggested mode and the 
+#  data itself.
+#
+proc ::uuencode::uudecode {args} {
+    array set opts {mode 0644 filename {}}
+    set wrongargs "wrong \# args: should be \"uudecode (-file filename | ?--? string)\""
+    while {[string match -* [lindex $args 0]]} {
+        switch -glob -- [lindex $args 0] {
+            -f* {
+                if {[llength $args] < 2} {
+                    return -code error $wrongargs
+                }
+                set opts(filename) [lindex $args 1]
+                set args [lreplace $args 0 0]
+            }
+            -- {
+                set args [lreplace $args 0 0]
+                break
+            }
+            default {
+                return -code error "bad option [lindex $args 0]:\
+                      must be -file"
+            }
+        }
+        set args [lreplace $args 0 0]
+    }
+
+    if {$opts(filename) != {}} {
+        set f [open $opts(filename) r]
+        set data [read $f]
+        close $f
+    } else {
+        if {[llength $args] != 1} {
+            return -code error $wrongargs
+        }
+        set data [lindex $args 0]
+    }
+
+    set state false
+    set result {}
+
+    foreach {line} [split $data "\n"] {
+        switch -exact -- $state {
+            false {
+                if {[regexp {^begin ([0-7]+) ([^\s]*)} $line \
+                         -> opts(mode) opts(name)]} {
+                    set state true
+                    set r {}
+                }
+            }
+
+            true {
+                if {[string match "end" $line]} {
+                    set state false
+                    lappend result [list $opts(name) $opts(mode) $r]
+                } else {
+                    scan $line %c c
+                    set n [expr {($c - 0x21)}]
+                    append r [string range \
+                                  [decode [string range $line 1 end]] 0 $n]
+                }
+            }
+        }
+    }
+
+    return $result
+}
+
+# -------------------------------------------------------------------------
+
+package provide uuencode $::uuencode::version
+
+# -------------------------------------------------------------------------
+#
+# Local variables:
+#   mode: tcl
+#   indent-tabs-mode: nil
+# End:
+

Added: trunk/plugins/vimage/libary/base64/yencode.tcl
===================================================================
--- trunk/plugins/vimage/libary/base64/yencode.tcl	                        (rev 0)
+++ trunk/plugins/vimage/libary/base64/yencode.tcl	2010-09-19 17:57:46 UTC (rev 393)
@@ -0,0 +1,315 @@
+# yencode.tcl - Copyright (C) 2002 Pat Thoyts <patthoyts at users.sourceforge.net>
+#
+# Provide a Tcl only implementation of yEnc encoding algorithm
+#
+# -------------------------------------------------------------------------
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# -------------------------------------------------------------------------
+# @(#)$Id: yencode.tcl,v 1.11 2005/09/28 04:51:19 andreas_kupries Exp $
+
+package require Tcl 8.2;                # tcl minimum version
+catch {package require crc32};          # tcllib 1.1
+catch {package require tcllibc};        # critcl enhancements for tcllib
+
+namespace eval ::yencode {
+    variable version 1.1.1
+    namespace export encode decode yencode ydecode
+}
+
+# -------------------------------------------------------------------------
+
+proc ::yencode::Encode {s} {
+    set r {}
+    binary scan $s c* d
+    foreach {c} $d {
+        set v [expr {($c + 42) % 256}]
+        if {$v == 0x00 || $v == 0x09 || $v == 0x0A 
+            || $v == 0x0D || $v == 0x3D} {
+            append r "="
+            set v [expr {($v + 42) % 256}]
+        }
+        append r [format %c $v]
+    }
+    return $r
+}
+
+proc ::yencode::Decode {s} {
+    if {[string length $s] == 0} {return ""}
+    set r {}
+    set esc 0
+    binary scan $s c* d
+    foreach c $d {
+        if {$c == 61 && $esc == 0} {
+            set esc 1
+            continue
+        }
+        set v [expr {($c - 42) % 256}]
+        if {$esc} {
+            set v [expr {($v - 42) % 256}]
+            set esc 0
+        }
+        append r [format %c $v]
+    }
+    return $r
+}
+
+# -------------------------------------------------------------------------
+# C coded versions for critcl built base64c package
+# -------------------------------------------------------------------------
+
+if {[package provide critcl] != {}} {
+    namespace eval ::yencode {
+        critcl::ccode {
+            #include <string.h>
+        }
+        critcl::ccommand CEncode {dummy interp objc objv} {
+            Tcl_Obj *inputPtr, *resultPtr;
+            int len, rlen, xtra;
+            unsigned char *input, *p, *r, v;
+            
+            if (objc !=  2) {
+                Tcl_WrongNumArgs(interp, 1, objv, "data");
+                return TCL_ERROR;
+            }
+            
+            /* fetch the input data */
+            inputPtr = objv[1];
+            input = Tcl_GetByteArrayFromObj(inputPtr, &len);
+
+            /* calculate the length of the encoded result */
+            rlen = len;
+            for (p = input; p < input + len; p++) {
+                v = (*p + 42) % 256;
+                if (v == 0 || v == 9 || v == 0x0A || v == 0x0D || v == 0x3D)
+                   rlen++;
+            }
+            
+            /* allocate the output buffer */
+            resultPtr = Tcl_GetObjResult(interp);
+            if (Tcl_IsShared(resultPtr)) {
+                resultPtr = Tcl_DuplicateObj(resultPtr);
+                Tcl_SetObjResult(interp, resultPtr);
+            }
+            r = Tcl_SetByteArrayLength(resultPtr, rlen);
+            
+            /* encode the input */
+            for (p = input; p < input + len; p++) {
+                v = (*p + 42) % 256;
+                if (v == 0 || v == 9 || v == 0x0A || v == 0x0D || v == 0x3D) {
+                    *r++ = '=';
+                    v = (v + 42) % 256;
+                }
+                *r++ = v;
+            }
+
+            return TCL_OK;
+        }
+
+        critcl::ccommand CDecode {dummy interp objc objv} {
+            Tcl_Obj *inputPtr, *resultPtr;
+            int len, rlen, esc;
+            unsigned char *input, *p, *r, v;
+            
+            if (objc !=  2) {
+                Tcl_WrongNumArgs(interp, 1, objv, "data");
+                return TCL_ERROR;
+            }
+            
+            /* fetch the input data */
+            inputPtr = objv[1];
+            input = Tcl_GetByteArrayFromObj(inputPtr, &len);
+
+            /* allocate the output buffer */
+            resultPtr = Tcl_GetObjResult(interp);
+            if (Tcl_IsShared(resultPtr)) {
+                resultPtr = Tcl_DuplicateObj(resultPtr);
+                Tcl_SetObjResult(interp, resultPtr);
+            }
+            r = Tcl_SetByteArrayLength(resultPtr, len);
+            
+            /* encode the input */
+            for (p = input, esc = 0, rlen = 0; p < input + len; p++) {
+                if (*p == 61 && esc == 0) {
+                    esc = 1;
+                    continue;
+                }
+                v = (*p - 42) % 256;
+                if (esc) {
+                    v = (v - 42) % 256;
+                    esc = 0;
+                }
+                *r++ = v;
+                rlen++;
+            }
+            Tcl_SetByteArrayLength(resultPtr, rlen);
+
+            return TCL_OK;
+        }
+    }
+}
+
+if {[info command ::yencode::CEncode] != {}} {
+    interp alias {} ::yencode::encode {} ::yencode::CEncode
+    interp alias {} ::yencode::decode {} ::yencode::CDecode
+} else {
+    interp alias {} ::yencode::encode {} ::yencode::Encode
+    interp alias {} ::yencode::decode {} ::yencode::Decode
+}
+
+# -------------------------------------------------------------------------
+# Description:
+#  Pop the nth element off a list. Used in options processing.
+#
+proc ::yencode::Pop {varname {nth 0}} {
+    upvar $varname args
+    set r [lindex $args $nth]
+    set args [lreplace $args $nth $nth]
+    return $r
+}
+
+# -------------------------------------------------------------------------
+
+proc ::yencode::yencode {args} {
+    array set opts {mode 0644 filename {} name {} line 128 crc32 1}
+    while {[string match -* [lindex $args 0]]} {
+        switch -glob -- [lindex $args 0] {
+            -f* { set opts(filename) [Pop args 1] }
+            -m* { set opts(mode) [Pop args 1] }
+            -n* { set opts(name) [Pop args 1] }
+            -l* { set opts(line) [Pop args 1] }
+            -c* { set opts(crc32) [Pop args 1] }
+            --  { Pop args ; break }
+            default {
+                set options [join [lsort [array names opts]] ", -"]
+                return -code error "bad option [lindex $args 0]:\
+                      must be -$options"
+            }
+        }
+        Pop args
+    }
+
+    if {$opts(name) == {}} {
+        set opts(name) $opts(filename)
+    }
+    if {$opts(name) == {}} {
+        set opts(name) "data.dat"
+    }
+    if {! [string is boolean $opts(crc32)]} {
+        return -code error "bad option -crc32: argument must be true or false"
+    }
+
+    if {$opts(filename) != {}} {
+        set f [open $opts(filename) r]
+        fconfigure $f -translation binary
+        set data [read $f]
+        close $f
+    } else {
+        if {[llength $args] != 1} {
+            return -code error "wrong \# args: should be\
+                  \"yencode ?options? -file name | data\""
+        }
+        set data [lindex $args 0]
+    }
+    
+    set opts(size) [string length $data]
+    
+    set r {}
+    append r [format "=ybegin line=%d size=%d name=%s" \
+                  $opts(line) $opts(size) $opts(name)] "\n"
+
+    set ndx 0
+    while {$ndx < $opts(size)} {
+        set pln [string range $data $ndx [expr {$ndx + $opts(line) - 1}]]
+        set enc [encode $pln]
+        incr ndx [string length $pln]
+        append r $enc "\r\n"
+    }
+
+    append r [format "=yend size=%d" $ndx]
+    if {$opts(crc32)} {
+        append r " crc32=" [crc::crc32 -format %x $data]
+    }
+    return $r
+}
+
+# -------------------------------------------------------------------------
+# Description:
+#  Perform ydecoding of a file or data. A file may contain more than one
+#  encoded data section so the result is a list where each element is a 
+#  three element list of the provided filename, the file size and the 
+#  data itself.
+#
+proc ::yencode::ydecode {args} {
+    array set opts {mode 0644 filename {} name default.bin}
+    while {[string match -* [lindex $args 0]]} {
+        switch -glob -- [lindex $args 0] {
+            -f* { set opts(filename) [Pop args 1] }
+            -- { Pop args ; break; }
+            default {
+                set options [join [lsort [array names opts]] ", -"]
+                return -code error "bad option [lindex $args 0]:\
+                      must be -$opts"
+            }
+        }
+        Pop args
+    }
+
+    if {$opts(filename) != {}} {
+        set f [open $opts(filename) r]
+        set data [read $f]
+        close $f
+    } else {
+        if {[llength $args] != 1} {
+            return -code error "wrong \# args: should be\
+                  \"ydecode ?options? -file name | data\""
+        }
+        set data [lindex $args 0]
+    }
+
+    set state false
+    set result {}
+
+    foreach {line} [split $data "\n"] {
+        set line [string trimright $line "\r\n"]
+        switch -exact -- $state {
+            false {
+                if {[string match "=ybegin*" $line]} {
+                    regexp {line=(\d+)} $line -> opts(line)
+                    regexp {size=(\d+)} $line -> opts(size)
+                    regexp {name=(\d+)} $line -> opts(name)
+
+                    if {$opts(name) == {}} {
+                        set opts(name) default.bin
+                    }
+
+                    set state true
+                    set r {}
+                }
+            }
+
+            true {
+                if {[string match "=yend*" $line]} {
+                    set state false
+                    lappend result [list $opts(name) $opts(size) $r]
+                } else {
+                    append r [decode $line]
+                }
+            }
+        }
+    }
+
+    return $result
+}
+
+# -------------------------------------------------------------------------
+
+package provide yencode $::yencode::version
+
+# -------------------------------------------------------------------------
+#
+# Local variables:
+#   mode: tcl
+#   indent-tabs-mode: nil
+# End:
+

Modified: trunk/plugins/vimage/msgs/ru.msg
===================================================================
--- trunk/plugins/vimage/msgs/ru.msg	2010-09-19 15:53:49 UTC (rev 392)
+++ trunk/plugins/vimage/msgs/ru.msg	2010-09-19 17:57:46 UTC (rev 393)
@@ -1,24 +1,18 @@
-::msgcat::mcset ru "Whether the vimage plugin is loaded." "Загружает/выгружает плагин Vimage"
-::msgcat::mcset ru "Vimage options" "Опции плагина Vimage"
-::msgcat::mcset ru "Download image when a new message" "Автоматически скачивать изображение, если его ссылка находится в теле сообщения"
-::msgcat::mcset ru "Automatic show downloaded images" "Автоматически открывать изображение по завершении скачивания."
-::msgcat::mcset ru "Show images from history" "Загружать изображения истории"
-::msgcat::mcset ru "Max size of image (kb)." "Максимальный размер изображения (kb)"
-::msgcat::mcset ru "Downloaded urls - background color" "Цвет фона ссылок на скачанные изображения"
-::msgcat::mcset ru "Process urls - background color" "Цвет фона ссылок скачивающихся изображений"
-::msgcat::mcset ru "Vimage - view" "Vimage - просмотр"
-::msgcat::mcset ru "Compulsory viewing" "Принудительный просмотр"
-::msgcat::mcset ru "Show" "Показать"
-::msgcat::mcset ru "Reload" "Перезагрузить"
-::msgcat::mcset ru "Save" "Сохранить"
-::msgcat::mcset ru "Back" "Назад"
+::msgcat::mcset ru "Whether the vimage plugin is loaded." "Загружает и выгружает плагин \"Vimage\"."
+::msgcat::mcset ru "Vimage - view" "Vimage - просмотр."
+::msgcat::mcset ru "View" "Показать."
+::msgcat::mcset ru "Reload" "Перезагрузить."
+::msgcat::mcset ru "View without size limit" "Показать игнорируя ограничения."
+::msgcat::mcset ru "Save" "Сохранить."
+::msgcat::mcset ru "Back" "Назад."
 ::msgcat::mcset ru "Zoom" "Увеличение"
 ::msgcat::mcset ru "Zoom in" "Приблизить"
 ::msgcat::mcset ru "Zoom out" "Отдалить"
-::msgcat::mcset ru "Tools" "Инструменты"
-::msgcat::mcset ru "Flip LR" "Развернуть слева направо"
-::msgcat::mcset ru "Flip TB" "Развернуть сверху вниз"
-::msgcat::mcset ru "Flip both" "Развернуть"
-::msgcat::mcset ru "Unsaved" "Не сохранено"
-::msgcat::mcset ru "Saved to %s" "Сохранено в %s"
-::msgcat::mcset ru "Saved" "Сохранено"
\ No newline at end of file
+::msgcat::mcset ru "Vimage options" "Настройки Vimage"
+::msgcat::mcset ru "Download image when a draw new message." "Загружать изображение, если пришло новое сообщение."
+::msgcat::mcset ru "Automatic show downloaded images." "Автоматически показывать загруженные изображения."
+::msgcat::mcset ru "Use color-shemes for image urls." "Использовать цветовые схемы для ссылок изображений."
+::msgcat::mcset ru "Activate Tkabber window, if the picture downloaded." "Активировать окно Tkabber, если картинка загрузилась."
+::msgcat::mcset ru "Use topmost window." "Отображать поверх всех окон."
+::msgcat::mcset ru "Use toolwindow style." "Использовать новый стиль отображения окна."
+::msgcat::mcset ru "Maximum size of content (kb)." "Максимальный размер контента (кб)."
\ No newline at end of file

Added: trunk/plugins/vimage/pixmaps/big.gif
===================================================================
(Binary files differ)


Property changes on: trunk/plugins/vimage/pixmaps/big.gif
___________________________________________________________________
Added: svn:mime-type
   + application/octet-stream

Added: trunk/plugins/vimage/pixmaps/none.gif
===================================================================
(Binary files differ)


Property changes on: trunk/plugins/vimage/pixmaps/none.gif
___________________________________________________________________
Added: svn:mime-type
   + application/octet-stream

Deleted: trunk/plugins/vimage/readme.ru
===================================================================
--- trunk/plugins/vimage/readme.ru	2010-09-19 15:53:49 UTC (rev 392)
+++ trunk/plugins/vimage/readme.ru	2010-09-19 17:57:46 UTC (rev 393)
@@ -1,14 +0,0 @@
-Версия - alpha. (выложен в качестве примера функциональности, хотя и можно нормально использовать выставив отпции:
-options(auto_show_image) 0
-options(shadow_download_image) 0
-)
-
-Основные проблемы:
- - Скачивание изображений и их отображение начиная с самой загрузки Tkabber. 
- - Проблемы с отображением скачанных изображений (ошибки скачивания, проблема http).
- - Требуется модификация regexp (парсинг url'ов)
- - Работа над английским и русским языками
- 
-Возможности:
-Плагин умеет загружаться/выгружатся динамически. Если стоит опция {shadow_download_image 1}, то при появлении нового сообщения, и найденной в нём ссылки на изображение, это изображение начинает скачиватся. Далее, если стоит опция {options(auto_show_image) 1}, то изображение автоматически появится на экране. Если нет, то ссылка ожидает события "средняя кнопка мыши", либо клик, по соответствующему меню, по нажатии на правую кнопку мыши. Если появилось изображение "Image is too large", то вы можете нажать правую кнопку мыши ==> "Принудительный просмотр", опция max_size при этом не учитывется. Если изображение отображается неверно (ошибки http), то вы можете нажать правую кнопку мыши ==> "Перезагрузить". Эффект "Правая кнопка мыши ==> Показать" аналогичен средней кнопке мыши. На появившемся окне с изображением вы можете нажать правую кнопку, и в меню выбрать "Сохранить" - сохранить локально на диск, "Назад" - скрыть изображение "Увеличение - Приблизить/Отдалить" - увеличивает или уменьшает изображение. В "Инструменты вы можете повернуть изображение." Во время скачивания изображения, фон ссылок становятся оранжевого цвета, по-окончании - красного (опционально).
-  
\ No newline at end of file

Modified: trunk/plugins/vimage/vimage.tcl
===================================================================
--- trunk/plugins/vimage/vimage.tcl	2010-09-19 15:53:49 UTC (rev 392)
+++ trunk/plugins/vimage/vimage.tcl	2010-09-19 17:57:46 UTC (rev 393)
@@ -1,20 +1,30 @@
 namespace eval vimage {
 	variable options
+	variable extensions
+
+	package require http
+	package require msgcat
 	
-	::msgcat::mcload [file join [file dirname [info script] ] msgs]
+	set script_dir [file dirname [info script]]
+	::msgcat::mcload [file join $script_dir msgs]
 	
-	set options(extensions) {gif|pixmap}
+	lappend ::auto_path [file join $script_dir libary]
+	package require base64
+	
+#	+++	( Get a supported image extensions )	
+	set extensions {gif|pixmap}
 	if { [catch { package require Img } ] == 0 } {
-		append options(extensions) {|bmp|ico|jpeg|jpg|pcx|}
-		append options(extensions) {png|ppm|postscript|sgi|sun|}
-		append options(extensions) {tga|tiff|xbm|xpm}
+		append extensions {|bmp|ico|jpeg|jpg|pcx|}
+		append extensions {png|ppm|postscript|sgi|sun|}
+		append extensions {tga|tiff|xbm|xpm}
 	}	
 
-	image create photo Big -file \
-		[file join [file dirname [info script] ] images big.gif]
+#	+++	( Default images )
+	image create photo LARGE \
+	-file [file join $script_dir pixmaps big.gif]
 		
-	image create photo None -file \
-		[file join [file dirname [info script] ] images none.gif]
+	image create photo ERROR \
+	-file [file join $script_dir pixmaps none.gif]
 	
 	if {![::plugins::is_registered vimage]} {
 		::plugins::register vimage \
@@ -25,162 +35,149 @@
               -unloadcommand [namespace code unload]
 		return
     }
-	
-	custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber	
-    custom::defgroup Vimage [::msgcat::mc "Vimage options"] -group Plugins	
-		
-	custom::defvar options(shadow_download_image) 1 \
-		[::msgcat::mc "Download image when a new message"] \
-		-group Vimage -type boolean
-		
-	custom::defvar options(auto_show_image) 1 \
-		[::msgcat::mc "Automatic show downloaded images"] \
-		-group Vimage -type boolean
-		
-	custom::defvar options(show_images_from_history) 0 \
-		[::msgcat::mc "Show images from history"] \
-		-group Vimage -type boolean
-		
-	custom::defvar options(max_size) 50 \
-			[::msgcat::mc "Max size of image (kb)."] \
-			-type string -group Vimage	
-		
-	custom::defvar options(background_active_urls) red \
-			[::msgcat::mc "Downloaded urls - background color"] \
-			-type string -group Vimage	
-			
-	custom::defvar options(background_process_urls) yellow \
-			[::msgcat::mc "Process urls - background color"] \
-			-type string -group Vimage	
 }
 
-# # # # # # # # # # # # # # # # # # # # # # # # 
 proc vimage::load {} {
-	hook::add draw_message_post_hook \
-			[namespace current]::drawMessage 50
+	hook::add draw_message_hook \
+			[namespace current]::draw_message 50
 	hook::add chat_win_popup_menu_hook \
 			[namespace current]::add_view_button 1
 }
 
 proc vimage::unload {} {
-	hook::remove draw_message_post_hook \
-			[namespace current]::drawMessage 50
+	hook::remove draw_message_hook \
+			[namespace current]::draw_message 50
 	hook::remove chat_win_popup_menu_hook \
 			[namespace current]::add_view_button 1
-		
 }
-# # # # # # # # # # # # # # # # # # # # # # # # 
 
+#################################################
 
-proc vimage::drawMessage { chatid from type body extras } {
+proc vimage::draw_message { chatid from type body extras } {
 	variable options
+	variable extensions
 	
-	if { $options(show_images_from_history) == 0 && [lindex [lindex $extras 4] 2] ne {}} {
-		return -code break
+	if { [::xmpp::delay::exists $extras] } {
+	return
 	}
 	
+	if { $options(active_is_message) == 0 } {
+	return
+	}
+	
+	set map [format {[http://][^\s]+\.(%s)} $extensions]
+	set matched [regexp -inline -nocase -all -- $map $body]
 	set chatwin [chat::chat_win $chatid]
 	
-	foreach url [regexp -inline -all [format {https*://[^\s]+[%s]} $options(extensions)] $body] {
-		if { $options(shadow_download_image) } {
-			puts $url
-			after 0 [list [namespace current]::imageProcess $url $chatwin]
-		}
+	foreach { url ext } $matched {
+		after 0 [list [namespace current]::image_process $url $chatwin]
 	}
 }
 
-proc vimage::imageProcess { url w } {
+
+proc vimage::image_process { url chatwin } {
 	variable images
 	variable options
 	
-	if { [info exist images($url,data)] == 0 && \
-		$options(shadow_download_image) } {
-			imageGet $url
-			imageCreate $w $url
-	} else {
-			imageCreate $w $url
-	}
+	if { ![info exist images($url,data)] } {
+		image_get $url $chatwin
+	} 
+	
+	image_create $chatwin $url
 }
 
-proc vimage::imageReload { url w } {
+
+proc vimage::image_reload { url chatwin } {
 	variable images
 	
 	array unset images $url,*
-	imageProcess $url $w
+	image_process $url $chatwin
 }
 
-proc vimage::imageGet { url } {
+
+proc vimage::image_get { url chatwin } {
 	variable images
 	
-	if { [catch {
-		set token [http::geturl $url -binary 1 \
-			-command [list [namespace current]::imageGetEnd $url] \
-			-blocksize 1000 \
-			-progress [list [namespace current]::imageGetProcess $url] \
-			-timeout 10000]
-		http::wait $token
-	}]} {
-		return [set images($url,full) None]
-	}	
+	set ns [namespace current]
+	change_state_url $url $chatwin process
+	
+	set token [http::geturl $url -binary 0 \
+		-command [list ${ns}::image_get_end $chatwin $url] \
+		-blocksize 1024 \
+		-progress [list ${ns}::image_get_process $chatwin $url]]
+		
+	http::wait $token
 }
 
-proc vimage::imageGetEnd { url token } {
+
+proc vimage::image_get_end { chatwin url token } {
 	variable images
 	
 	set images($url,data) [http::data $token]
 	http::cleanup $token
+	change_state_url $url $chatwin end
 }
 
-proc vimage::imageGetProcess { url token total current } {
+
+proc vimage::image_get_process { chatwin url token total current } {
 	variable options
 	variable images
 	
 	puts $current
 	
-	if { [expr { round($current / 1024) }] > $options(max_size) || \
-		[expr { round($total / 1024) }] > $options(max_size)} {
-			set images($url,full) Big
-			return [http::reset $token]
+	set max_size [expr {$options(max_size)*1024}]
+	if { $current > $max_size || $total > $max_size} {
+		set images($url,full) LARGE
+		http::reset $token
 	}
 }
 
-proc vimage::imageCreate { w url } {
+
+proc vimage::image_create { chatwin url } {
 	variable images
 	variable options
 	
 	if { [info exist images($url,full)] == 0 } {
-		if {[catch {set images($url,full) [image create photo -data $images($url,data)]}]} {
-			set images($url,full) None
+		set images($url,data) [base64::encode $images($url,data)]
+		if { [catch {set images($url,full) [image create photo -data $images($url,data)]}] } {
+			set images($url,full) ERROR
+			change_state_url $url $chatwin error
 		}
+	} elseif { $images($url,full) eq "ERROR" || $images($url,full) eq "LARGE" } {
+		change_state_url $url $chatwin error
 	}
 	
-	$w tag bind "uri $url" <2> [list [namespace current]::imageFullShow $w $url]
-	
-	changeColor $w $url
-	imageUpdate $w $url
-	
 	if { $options(auto_show_image) } {
-		imageFullShow $w $url
+		image_full_show $chatwin $url
 	}
 }
 
-proc vimage::imageUpdate { w url } {
-	if { [winfo exist .fullshow] } { 
-		imageFullShow $w $url
-	}
-}
 
-proc vimage::changeColor { w url } {
+proc vimage::change_state_url { url chatwin type } {
 	variable options
-	$w tag configure "uri $url" -background $options(background_active_urls)
+	
+	if { $options(use_colors) == 0 } {
+		return
+	}
+	
+	switch -- $type {
+		process {
+			$chatwin tag configure "uri $url" \
+				-background #7f7f7f
+		}
+		end {
+			$chatwin tag configure "uri $url" \
+				-background green
+		}
+		error {
+			$chatwin tag configure "uri $url" \
+				-background red
+		}
+	}
 }
 
-proc vimage::changeColorProcess { w url } {
-	variable options
-	$w tag configure "uri $url" -background $options(background_process_urls)
-}
- 
-proc vimage::imageScale { im xfactor { yfactor 0 } } {
+
+proc vimage::image_scale { im xfactor { yfactor 0 } } {
 	set mode -subsample
 	if { abs($xfactor) < 1 } {
 		set xfactor [expr { round(1./$xfactor) }]
@@ -192,37 +189,52 @@
 		set yfactor $xfactor
 	}
 	
-		set dest [image create photo]
-		$dest copy $im
-		$im blank
-		$im copy $dest -shrink $mode $xfactor $yfactor
-		image delete $dest
+	set dest [image create photo]
+	$dest copy $im -shrink $mode $xfactor $yfactor
+	.fullshow.image configure -image $dest
 }
 
-proc vimage::imageFullShow { w url } {
+
+proc vimage::image_full_show { w url } {
 	variable images
+	variable options
 	
 	if { [winfo exist .fullshow] } { 
 		destroy .fullshow 
 	}
-
+	
 	toplevel .fullshow
 	
-	wm attributes .fullshow -topmost 1
-	wm attributes .fullshow -toolwindow 1
+	if { [option_exist topmost] } {
+	wm attributes .fullshow -topmost $options(topmost)
+	}
 	
+	if { [option_exist toolwindow] } {
+	wm attributes .fullshow -toolwindow $options(toolwindow)
+	}
+	
 	wm title .fullshow [::msgcat::mc "Vimage - view"]
 	wm resizable .fullshow 0 0
 	
 	label .fullshow.image -image $images($url,full)
 	pack .fullshow.image
 	
+	if {$options(activate_tkabber)} {
+        ::ifacetk::systray::restore
+        if { [focus] == "" } {
+           focus -force .
+        }
+	}
+	
 	bind .fullshow <1> [list destroy .fullshow]
-	bind .fullshow <3> [list [namespace current]::popup_menu %W %X %Y $images($url,full) $url]
+	bind .fullshow <3> [list [namespace current]::popup_menu %X %Y $images($url,full) $url]
 }
 
+
 proc vimage::add_view_button { m chatwin X Y x y } {
 	variable options
+	variable extensions
+	variable images
 	
 	set tags [$chatwin tag names "@$x,$y"]	
     set idx [lsearch $tags href_*]
@@ -239,90 +251,131 @@
 		set url [$w get $a $b]
     }
 	
-	if { [lsearch -nocase -regexp [file extension $url] $options(extensions)] < 0 } {
-		return -code break
+	if { [lsearch -nocase -regexp [file extension $url] $extensions] < 0 } {
+		return
 	}
 	
+	if { ![info exist  images($url,data)] } { set ist disabled } { set ist normal }
+	
 	$m add command \
-		-label [::msgcat::mc "Show"] \
-		-command [list [namespace current]::imageProcess $url $chatwin]
+		-label [::msgcat::mc "View"] \
+		-command [list [namespace current]::image_process $url $chatwin]
+	
 	$m add command \
 		-label [::msgcat::mc "Reload"] \
-		-command [list [namespace current]::imageReload $url $chatwin]
+		-command [list [namespace current]::image_reload $url $chatwin] \
+		-state $ist
+	
 	$m add command \
-		-label [::msgcat::mc "Compulsory viewing"] \
-		-command [list [namespace current]::imageCompProcess $url $chatwin]
+		-label [::msgcat::mc "View without size limit"] \
+		-command [list [namespace current]::image_comp_process $url $chatwin] \
+		-state $ist
+		
 	$m add separator
 }
 
-proc vimage::imageCompProcess { url w } {
+
+proc vimage::image_comp_process { url chatwin } {
 	variable options
-	variable images
 	
 	set options_max_size_old $options(max_size)
 	set options(max_size) 2000
 	
-	array unset images $url,*
-	imageProcess $url $w
+	image_reload $url $chatwin
 	
 	set options(max_size) $options_max_size_old
 }
 
-proc vimage::popup_menu { W X Y img url } {
 
-    set m .zomm_popup
+proc vimage::popup_menu { X Y img url } {
+
+    set m .fs_popup
 	
-    if {[winfo exists $m]} {
+    if { [winfo exists $m] } {
 		destroy $m
     }
 
     menu $m -tearoff 0
 	
 	$m add command -label [::msgcat::mc "Save"] \
-			-command [list [namespace current]::imageSave $url]
+		-command [list [namespace current]::image_save $url]
 	$m add command -label [::msgcat::mc "Back"] \
-			-command [list event generate .fullshow <1>]
+		-command [list event generate .fullshow <1>]
 	$m add separator
 	$m add cascade -label  [::msgcat::mc "Zoom"] \
-			-menu [menu $m.zoom -tearoff 0]	
+		-menu [menu $m.zoom -tearoff 0]	
 	$m.zoom add command -label [::msgcat::mc "Zoom in"] \
-			-command [list [namespace current]::imageScale $img 2]
+		-command [list [namespace current]::image_scale $img 2]
 	$m.zoom add command -label [::msgcat::mc "Zoom out"] \
-			-command [list [namespace current]::imageScale $img 0.5]		
-
-	$m add cascade -label  [::msgcat::mc "Tools"] \
-			-menu [menu $m.tools -tearoff 0]	
-	$m.tools add command -label [::msgcat::mc "Flip LR"] \
-			-command [list [namespace current]::imageScale $img -1 1]
-	$m.tools add command -label [::msgcat::mc "Flip TB"] \
-			-command [list [namespace current]::imageScale $img 1 -1]
-	$m.tools add command -label [::msgcat::mc "Flip both"] \
-			-command [list [namespace current]::imageScale $img -1 -1]
+		-command [list [namespace current]::image_scale $img 0.5]
     
     tk_popup $m $X $Y
 }
 
-proc vimage::imageSave { url } {
+
+proc vimage::image_save { url } {
 	variable options
 	variable images
-
-	event generate .fullshow <1>
 	
+	if { [winfo exists .fullshow] } {
+		destroy .fullshow
+    }
+	
 	set filename [tk_getSaveFile -initialfile [file tail $url] \
 		-filetypes [list [list [string toupper [file extension $url]] \
 		[file extension $url]]]]
 	
 	
 	if { $filename eq {} } { 
-		return [tk_messageBox -message [::msgcat::mc "Unsaved"] \
-			-title [::msgcat::mc "Unsaved"]]
+	return 
 	}
    
 	set fileid [open $filename "WRONLY CREAT"]
 	fconfigure $fileid -translation binary
-	puts $fileid $images($url,data)
+	puts $fileid [base64::decode $images($url,data)]
 	close $fileid
+}
+
+
+proc vimage::option_exist option {
+	return [expr {[lsearch -exact [wm attributes .] -$option] >= 0}]
+}
+
+namespace eval vimage {
+	variable options 
 	
-	tk_messageBox -message [::msgcat::mc "Saved to %s" $filename] \
-		-title [::msgcat::mc "Saved"]
+	custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber	
+    custom::defgroup Vimage [::msgcat::mc "Vimage options"] -group Plugins	
+		
+	custom::defvar options(active_is_message) 1 \
+	[::msgcat::mc "Download image when a draw new message."] \
+	-group Vimage -type boolean
+		
+	custom::defvar options(auto_show_image) 1 \
+	[::msgcat::mc "Automatic show downloaded images."] \
+	-group Vimage -type boolean
+	
+	custom::defvar options(use_colors) 1 \
+	[::msgcat::mc "Use color-shemes for image urls."] \
+	-type boolean -group Vimage		
+		
+	custom::defvar options(activate_tkabber) 1 \
+	[::msgcat::mc "Activate Tkabber window, if the picture downloaded."] \
+	-type boolean -group Vimage
+
+	if { [option_exist topmost] } {
+		custom::defvar options(topmost) 0 \
+		[::msgcat::mc "Use topmost window."] \
+		-type boolean -group Vimage
+	}
+	
+	if { [option_exist toolwindow] } {
+		custom::defvar options(toolwindow) 1 \
+		[::msgcat::mc "Use toolwindow style."] \
+		-type boolean -group Vimage
+	}
+	
+	custom::defvar options(max_size) 50 \
+	[::msgcat::mc "Maximum size of content (kb)."] \
+	-type string -group Vimage	
 }
\ No newline at end of file



More information about the Tkabber-dev mailing list