[Tkabber-dev] r1607 - trunk/tkabber

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Wed Nov 5 21:23:48 MSK 2008


Author: sergei
Date: 2008-11-05 21:23:47 +0300 (Wed, 05 Nov 2008)
New Revision: 1607

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/hooks.tcl
Log:
	* hooks.tcl: Added a procedure which removes function from a hook.
	  Also, it's allowed to stop processing hook by returning break code.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2008-11-04 17:09:08 UTC (rev 1606)
+++ trunk/tkabber/ChangeLog	2008-11-05 18:23:47 UTC (rev 1607)
@@ -1,3 +1,8 @@
+2008-11-05  Sergei Golovan  <sgolovan at nes.ru>
+
+	* hooks.tcl: Added a procedure which removes function from a hook.
+	  Also, it's allowed to stop processing hook by returning break code.
+
 2008-11-04  Sergei Golovan  <sgolovan at nes.ru>
 
 	* datagathering.tcl: Fixed typo.

Modified: trunk/tkabber/hooks.tcl
===================================================================
--- trunk/tkabber/hooks.tcl	2008-11-04 17:09:08 UTC (rev 1606)
+++ trunk/tkabber/hooks.tcl	2008-11-05 18:23:47 UTC (rev 1607)
@@ -9,6 +9,13 @@
     set $hook [lsort -real -index 1 [lsort -unique [set $hook]]]
 }
 
+proc hook::remove {hook func {seq 50}} {
+    variable $hook
+
+    set idx [lsearch -exact [set $hook] [list $func $seq]]
+    set $hook [lreplace [set $hook] $idx $idx]
+}
+
 proc hook::set_flag {hook flag} {
     variable F
     set idx [lsearch -exact $F(flags,$hook) $flag]
@@ -17,14 +24,14 @@
 
 proc hook::unset_flag {hook flag} {
     variable F
-    if {![lcontain $F(flags,$hook) $flag]} {
+    if {[lsearch -exact $F(flags,$hook) $flag] < 0} {
 	lappend F(flags,$hook) $flag
     }
 }
 
 proc hook::is_flag {hook flag} {
     variable F
-    return [expr ![lcontain $F(flags,$hook) $flag]]
+    return [expr {[lsearch -exact $F(flags,$hook) $flag] < 0}]
 }
 
 proc hook::run {hook args} {
@@ -40,12 +47,18 @@
     foreach func_prio [set $hook] {
 	set func [lindex $func_prio 0]
 	set code [catch { eval $func $args } state]
+
         debugmsg hook "$hook: $func -> $state (code $code)"
-	if {$code} {
-	    ::bgerror "Hook $hook failed\nProcedure\
-		       $func returned code $code\n$state"
+
+	if {$code == 1} {
+	    # return -code error (which would be weird) or just error
+
+	    ::bgerror [format "Hook %s failed\nProcedure %s returned code\
+			       %s\n%s" $hook $func $code $state]
 	}
-	if {(!$code) && ([cequal $state stop])} {
+	if {$code == 3 || ($code == 0 && [string equal $state stop])} {
+	    # return -code break or return stop
+
 	    break
 	}
     }



More information about the Tkabber-dev mailing list