[Tkabber-dev] r718 - in trunk/tkabber: . plugins/chat plugins/general plugins/roster

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sat Sep 16 22:53:44 MSD 2006


Author: sergei
Date: 2006-09-16 22:53:36 +0400 (Sat, 16 Sep 2006)
New Revision: 718

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/gpgme.tcl
   trunk/tkabber/hooks.tcl
   trunk/tkabber/messages.tcl
   trunk/tkabber/muc.tcl
   trunk/tkabber/plugins/chat/chatstate.tcl
   trunk/tkabber/plugins/chat/events.tcl
   trunk/tkabber/plugins/chat/send_message.tcl
   trunk/tkabber/plugins/general/avatars.tcl
   trunk/tkabber/plugins/roster/rosterx.tcl
   trunk/tkabber/presence.tcl
Log:
	* gpgme.tcl, hooks.tcl, messages.tcl, muc.tcl,
	  plugins/chat/chatstate.tcl, plugins/chat/events.tcl,
	  plugins/chat/send_message.tcl, plugins/general/avatars.tcl,
	  plugins/roster/rosterx.tcl, presence.tcl: Replaced hook::run
	  with upvar for hook::foldl (it is more simple and looks more
	  "ticklish").

	* hooks.tcl: Removed hook::foldl procedure.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2006-09-16 18:42:43 UTC (rev 717)
+++ trunk/tkabber/ChangeLog	2006-09-16 18:53:36 UTC (rev 718)
@@ -31,6 +31,15 @@
 
 	* examples/tkabber_setstatus: Moved to examples/tools subdirectory.
 
+	* gpgme.tcl, hooks.tcl, messages.tcl, muc.tcl,
+	  plugins/chat/chatstate.tcl, plugins/chat/events.tcl,
+	  plugins/chat/send_message.tcl, plugins/general/avatars.tcl,
+	  plugins/roster/rosterx.tcl, presence.tcl: Replaced hook::run
+	  with upvar for hook::foldl (it is more simple and looks more
+	  "ticklish").
+
+	* hooks.tcl: Removed hook::foldl procedure.
+
 2006-09-15  Sergei Golovan  <sgolovan at nes.ru>
 
 	* ifacetk/idefault.tcl: Bind mouse buttons to scroll events

Modified: trunk/tkabber/gpgme.tcl
===================================================================
--- trunk/tkabber/gpgme.tcl	2006-09-16 18:42:43 UTC (rev 717)
+++ trunk/tkabber/gpgme.tcl	2006-09-16 18:53:36 UTC (rev 718)
@@ -1006,15 +1006,16 @@
 
 #############################################################################
 
-proc ::ssj::make_signature {acc connid status} {
+proc ::ssj::make_signature {varname connid status} {
+    upvar 2 $varname var
     if {![cequal $status ""] && \
 	    ![catch { signed:output $connid $status } cdata] && \
 	    ![cequal $cdata ""]} {
-	lappend acc [jlib::wrapper:createtag x \
+	lappend var [jlib::wrapper:createtag x \
 			 -vars [list xmlns $::NS(signed)] \
 			 -chdata $cdata]
     }
-    return $acc
+    return
 }
 
 hook::add presence_xlist_hook ::ssj::make_signature
@@ -1144,13 +1145,14 @@
 
 #############################################################################
 
-proc ::ssj::process_x_signed {acc f x connid from type replyP} {
+proc ::ssj::process_x_signed {rowvar bodyvar f x connid from type replyP} {
+    upvar 2 $rowvar row
+    upvar 2 $bodyvar body
+
     if {!$replyP || [cequal $type error]} {
-	return $acc
+	return
     }
 
-    lassign $acc row body
-
     foreach xa $x {
 	jlib::wrapper:splitxml $xa tag vars isempty chdata children
 	set xmlns [jlib::wrapper:getattr $vars xmlns]
@@ -1159,7 +1161,7 @@
 
 	# in case the sender didn't check the exit code from gpg...
 	if {[cequal $chdata ""]} {
-	    return $acc
+	    return
 	}
 
 	set lb [join [lrange [split $f .] 0 end-1] .].title.signed
@@ -1173,20 +1175,21 @@
 	grid $lb -row 1 -column 2 -sticky e
     }
 
-    return $acc
+    return
 }
 
 hook::add message_process_x_hook ::ssj::process_x_signed 20
 
 #############################################################################
 
-proc ::ssj::process_x_encrypted {acc f x connid from type replyP} {
+proc ::ssj::process_x_encrypted {rowvar bodyvar f x connid from type replyP} {
+    upvar 2 $rowvar row
+    upvar 2 $bodyvar body
+
     if {!$replyP || [cequal $type error]} {
-	return $acc
+	return
     }
 
-    lassign $acc row body
-
     foreach xa $x {
 	jlib::wrapper:splitxml $xa tag vars isempty chdata children
 	set xmlns [jlib::wrapper:getattr $vars xmlns]
@@ -1203,7 +1206,7 @@
 	grid $lb -row 1 -column 3 -sticky e
     }
 
-    return $acc
+    return
 }
 
 hook::add message_process_x_hook ::ssj::process_x_encrypted 21

Modified: trunk/tkabber/hooks.tcl
===================================================================
--- trunk/tkabber/hooks.tcl	2006-09-16 18:42:43 UTC (rev 717)
+++ trunk/tkabber/hooks.tcl	2006-09-16 18:53:36 UTC (rev 718)
@@ -1,7 +1,6 @@
 # $Id$
 
-namespace eval hook {
-}
+namespace eval hook {}
 
 proc hook::add {hook func {seq 50}} {
     variable $hook
@@ -52,28 +51,3 @@
     }
 }
 
-proc hook::foldl {hook acc0 args} {
-    variable F
-    variable $hook
-
-    if {![info exists $hook]} {
-	return $acc0
-    }
-
-    set F(flags,$hook) {}
-
-    set acc $acc0
-    foreach func_prio [set $hook] {
-	set func [lindex $func_prio 0]
-	set code [catch { eval $func [list $acc] $args } state]
-        debugmsg hook "$hook: $func -> $state (code $code)"
-	if {$code} {
-	    ::bgerror "Hook $hook failed\nProcedure\
-		       $func returned code $code\n$state"
-	} else {
-	    set acc $state
-	}
-    }
-    return $acc
-}
-

Modified: trunk/tkabber/messages.tcl
===================================================================
--- trunk/tkabber/messages.tcl	2006-09-16 18:42:43 UTC (rev 717)
+++ trunk/tkabber/messages.tcl	2006-09-16 18:53:36 UTC (rev 718)
@@ -140,8 +140,8 @@
 
     incr row
     set last $row
-    lassign [hook::foldl message_process_x_hook [list $row $body] \
-	    $mw.rf $x $connid $from $type $replyP] row body
+    hook::run message_process_x_hook row body \
+	      $mw.rf $x $connid $from $type $replyP
 
     if {(!$replyP) && ($row == $last)} {
         destroy $mw
@@ -217,8 +217,9 @@
     $mw.body insert insert "\n"
 }
 
-proc message::process_x {acc f x connid from type replyP} {
-    lassign $acc row body
+proc message::process_x {rowvar bodyvar f x connid from type replyP} {
+    upvar 2 $rowvar row
+    upvar 2 $bodyvar body
 
     foreach xa $x {
 	jlib::wrapper:splitxml $xa tag vars isempty chdata children
@@ -233,7 +234,7 @@
 	    } \
 	}
 
-    return [list $row $body]
+    return
 }
 
 hook::add message_process_x_hook message::process_x 99

Modified: trunk/tkabber/muc.tcl
===================================================================
--- trunk/tkabber/muc.tcl	2006-09-16 18:42:43 UTC (rev 717)
+++ trunk/tkabber/muc.tcl	2006-09-16 18:53:36 UTC (rev 718)
@@ -1332,8 +1332,9 @@
 
 ###############################################################################
 
-proc muc::process_invitation {acc f x connid from type replyP} {
-    lassign $acc row body
+proc muc::process_invitation {rowvar bodyvar f x connid from type replyP} {
+    upvar 2 $rowvar row
+    upvar 2 $bodyvar body
 
     foreach xa $x {
 	jlib::wrapper:splitxml $xa tag vars isempty chdata children
@@ -1403,15 +1404,17 @@
     if {[info exists muc_group] && $muc_group != ""} {
 	process_x_conference $f $connid $muc_group $muc_password $row
 	incr row
-	return [list $row $muc_body]
+	set body $muc_body
+	return
     } elseif {[info exists xconference_group] && $xconference_group != ""} {
 	process_x_conference $f $connid $xconference_group \
 	    $xconference_password $row
 	incr row
-	return [list $row $xconference_body]
+	set body $xconference_body
+	return
     }
     
-    return $acc
+    return
 }
 
 hook::add message_process_x_hook muc::process_invitation

Modified: trunk/tkabber/plugins/chat/chatstate.tcl
===================================================================
--- trunk/tkabber/plugins/chat/chatstate.tcl	2006-09-16 18:42:43 UTC (rev 717)
+++ trunk/tkabber/plugins/chat/chatstate.tcl	2006-09-16 18:53:36 UTC (rev 718)
@@ -169,19 +169,20 @@
 hook::add chat_send_message_hook \
     [namespace current]::chatstate::clear_status_on_send
 
-proc chatstate::make_xlist {xlist chatid user body type} {
+proc chatstate::make_xlist {varname chatid user body type} {
     variable options
     variable chatstate
+    upvar 2 $varname var
 
     if {!$options(enable) || $type != "chat"} {
-	return $xlist
+	return
     }
 
     set chatstate(windowactive,$chatid) 1
 
-    lappend xlist [jlib::wrapper:createtag active \
-		       -vars [list xmlns $::NS(chatstate)]]
-    return $xlist
+    lappend var [jlib::wrapper:createtag active \
+		     -vars [list xmlns $::NS(chatstate)]]
+    return
 }
 
 hook::add chat_send_message_xlist_hook \

Modified: trunk/tkabber/plugins/chat/events.tcl
===================================================================
--- trunk/tkabber/plugins/chat/events.tcl	2006-09-16 18:42:43 UTC (rev 717)
+++ trunk/tkabber/plugins/chat/events.tcl	2006-09-16 18:53:36 UTC (rev 718)
@@ -240,21 +240,22 @@
 hook::add chat_send_message_hook \
     [namespace current]::events::clear_status_on_send
 
-proc events::make_xlist {xlist chatid user body type} {
+proc events::make_xlist {varname chatid user body type} {
     variable options
+    upvar 2 $varname var
 
     if {!$options(enable) || $type != "chat"} {
-	return $xlist
+	return
     }
 
     lappend events [jlib::wrapper:createtag offline]
     lappend events [jlib::wrapper:createtag delivered]
     lappend events [jlib::wrapper:createtag displayed]
     lappend events [jlib::wrapper:createtag composing]
-    lappend xlist [jlib::wrapper:createtag x \
-		       -vars [list xmlns $::NS(event)] \
-		       -subtags $events]
-    return $xlist
+    lappend var [jlib::wrapper:createtag x \
+		     -vars [list xmlns $::NS(event)] \
+		     -subtags $events]
+    return
 }
 
 hook::add chat_send_message_xlist_hook \

Modified: trunk/tkabber/plugins/chat/send_message.tcl
===================================================================
--- trunk/tkabber/plugins/chat/send_message.tcl	2006-09-16 18:42:43 UTC (rev 717)
+++ trunk/tkabber/plugins/chat/send_message.tcl	2006-09-16 18:53:36 UTC (rev 718)
@@ -21,8 +21,8 @@
 	if {[info exists ::chat::chats(thread,$chatid)]} {
 	    lappend command -thread $::chat::chats(thread,$chatid)
 	}
-	set xlist [hook::foldl chat_send_message_xlist_hook \
-			       {} $chatid $user $body $type]
+	set xlist {}
+	hook::run chat_send_message_xlist_hook xlist $chatid $user $body $type
 	if {![lempty $xlist]} {
 	    lappend command -xlist $xlist
 	}

Modified: trunk/tkabber/plugins/general/avatars.tcl
===================================================================
--- trunk/tkabber/plugins/general/avatars.tcl	2006-09-16 18:42:43 UTC (rev 717)
+++ trunk/tkabber/plugins/general/avatars.tcl	2006-09-16 18:53:36 UTC (rev 718)
@@ -60,18 +60,19 @@
 
 ##############################################################################
 
-proc ::avatar::get_presence_x {acc connid status} {
+proc ::avatar::get_presence_x {varname connid status} {
     variable avatar
     variable options
+    upvar 2 $varname var
 
     if {$options(announce) && [info exists avatar(userhash)]} {
 	set children [jlib::wrapper:createtag hash -chdata $avatar(userhash)]
-	lappend acc [jlib::wrapper:createtag x \
+	lappend var [jlib::wrapper:createtag x \
 			 -vars [list xmlns $::NS(xavatar)] \
 			 -subtags [list $children]]
 
     }
-    return $acc
+    return
 }
 
 hook::add presence_xlist_hook ::avatar::get_presence_x

Modified: trunk/tkabber/plugins/roster/rosterx.tcl
===================================================================
--- trunk/tkabber/plugins/roster/rosterx.tcl	2006-09-16 18:42:43 UTC (rev 717)
+++ trunk/tkabber/plugins/roster/rosterx.tcl	2006-09-16 18:53:36 UTC (rev 718)
@@ -5,8 +5,9 @@
 
 ###############################################################################
 
-proc rosterx::process_x {acc f x connid from type replyP} {
-    lassign $acc row body
+proc rosterx::process_x {rowvar bodyvar f x connid from type replyP} {
+    upvar 2 $rowvar row
+    upvar 2 $bodyvar body
 
     set rosterx 0
     foreach xa $x {
@@ -30,7 +31,7 @@
 	    } \
 	}
 
-    return [list $row $body]
+    return
 }
 
 hook::add message_process_x_hook [namespace current]::rosterx::process_x 60

Modified: trunk/tkabber/presence.tcl
===================================================================
--- trunk/tkabber/presence.tcl	2006-09-16 18:42:43 UTC (rev 717)
+++ trunk/tkabber/presence.tcl	2006-09-16 18:53:36 UTC (rev 718)
@@ -517,8 +517,8 @@
 	lappend newargs -stat $stat
     }
 
-    set x [hook::foldl presence_xlist_hook $xlist $connid $stat]
-    lappend newargs -xlist $x
+    hook::run presence_xlist_hook xlist $connid $stat
+    lappend newargs -xlist $xlist
 
     switch -- $status {
 	available   { set command [list jlib::send_presence] }



More information about the Tkabber-dev mailing list