[Tkabber-dev] r1502 - trunk/tkabber

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sat Sep 13 13:37:16 MSD 2008


Author: sergei
Date: 2008-09-13 13:37:16 +0400 (Sat, 13 Sep 2008)
New Revision: 1502

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/gpgme.tcl
Log:
	* gpgme.tcl: Ported key info processing to GPG package where its
	  format slightly differs from TclGPGME.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2008-09-11 15:23:11 UTC (rev 1501)
+++ trunk/tkabber/ChangeLog	2008-09-13 09:37:16 UTC (rev 1502)
@@ -1,3 +1,8 @@
+2008-09-12  Sergei Golovan  <sgolovan at nes.ru>
+
+	* gpgme.tcl: Ported key info processing to GPG package where its
+	  format slightly differs from TclGPGME.
+
 2008-09-11  Sergei Golovan  <sgolovan at nes.ru>
 
 	* plugins/chat/draw_timestamp.tcl: Raised priority to enable
@@ -3,5 +8,5 @@
 	  timestamps for error and info messages.
 
-	* gpgme.tcl: Added gpg package (http://code.google.com/p/tclgpg) as an
+	* gpgme.tcl: Added GPG package (http://code.google.com/p/tclgpg) as an
 	  alternative package for encryption/signing messages.
 

Modified: trunk/tkabber/gpgme.tcl
===================================================================
--- trunk/tkabber/gpgme.tcl	2008-09-11 15:23:11 UTC (rev 1501)
+++ trunk/tkabber/gpgme.tcl	2008-09-13 09:37:16 UTC (rev 1502)
@@ -222,24 +222,26 @@
     set titles {}
     set balloons {}
     foreach key $keys {
+	set key_info [$ctx($connid) -operation info-key -key $key]
+        foreach {k v} $key_info {
+	    if {[string equal $k email]} {
+		lappend titles $key $v
+		lappend balloons $key [key_balloon_text $key_info]
+		break
+	    }
+	}
         foreach {k v} [$ctx($connid) -operation info-key -key $key] {
-            if {![cequal $k subkeys]} {
-                continue
-            }
-            foreach subkey $v {
-                catch {unset params}
-                array set params $subkey
-                if {![info exists params(email)]} {
-                    continue
-                }
-		lappend titles $key $params(email)
-                if {![catch {format "%d%s/%s %s %s" $params(length)         \
-                                    [string range $params(algorithm) 0 0]   \
-                                    [string range $params(keyid) end-7 end] \
-                                    [clock format $params(created)          \
-                                           -format "%Y-%m-%d"]              \
-                                    $params(userid)} text]} {
-		    lappend balloons $key $text
+	    if {![string equal $k subkeys]} {
+		continue
+	    }
+
+	    foreach subkey $v {
+		foreach {k1 v1} $subkey {
+		    if {[string equal $k1 email]} {
+			lappend titles $key $v1
+			lappend balloons $key [key_balloon_text $subkey]
+			break
+		    }
 		}
 	    }
 	}
@@ -252,6 +254,26 @@
 	-modal local
 }
 
+proc ::ssj::key_balloon_text {key} {
+    array set params $key
+    if {[catch {format "%d%s/%s %s" $params(length)          \
+                       [string range $params(algorithm) 0 0]   \
+                       [string range $params(keyid) end-7 end] \
+                       [clock format $params(created)          \
+                                     -format "%Y-%m-%d"]} text]} {
+	return ""
+    }
+
+    foreach {k v} $key {
+	switch -- $k {
+	    userid {
+		append text [format "\n\t%s" $v]
+	    }
+	}
+    }
+    return $text
+}
+
 proc ::ssj::once_only_aux {dw connid} {
     variable selectkey$connid
 
@@ -421,17 +443,22 @@
         if {[info exists sparams(key)]} {
             set sparams(key) [$ctx($connid) -operation info-key -key $sparams(key)]
             foreach {k v} $sparams(key) {
-                if {![cequal $k subkeys]} {
-                    continue
-                }
-                foreach subkey $v {
-                    catch {unset kparams}
-                    array set kparams $subkey
-                    if {[info exists kparams(keyid)]} {
-                        set j2k($from) $kparams(keyid)
-                        break
-                    }
-                }
+		switch -- $k {
+		    keyid {
+			set j2k($from) $v
+			break
+		    }
+		    subkeys {
+			foreach subkey $v {
+			    catch {unset kparams}
+			    array set kparams $subkey
+			    if {[info exists kparams(keyid)]} {
+				set j2k($from) $kparams(keyid)
+				break
+			    }
+			}
+		    }
+		}
             }
         }
 



More information about the Tkabber-dev mailing list