[Tcldrop/CVS] tcldrop/modules core.tcl

[Philip Moore]

CVSROOT:        /cvsroot/tcldrop
Module name:    tcldrop
Branch:         
Changes by:     Philip Moore <address@hidden>   03/12/01 03:06:54

Modified files:
        modules        : core.tcl 

Log message:
        Added "load" and "unld" bind types. (for module loading/unloading)

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/core.tcl.diff?tr1=1.26&tr2=1.27&r1=text&r2=text

Patches:
Index: tcldrop/modules/core.tcl
diff -u tcldrop/modules/core.tcl:1.26 tcldrop/modules/core.tcl:1.27
--- tcldrop/modules/core.tcl:1.26       Sun Nov 30 20:59:51 2003
+++ tcldrop/modules/core.tcl    Mon Dec  1 03:06:54 2003
@@ -1,6 +1,6 @@
 # core.tcl --
 #
-# $Id: core.tcl,v 1.26 2003/12/01 01:59:51 fireegl Exp $
+# $Id: core.tcl,v 1.27 2003/12/01 08:06:54 fireegl Exp $
 #
 # Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
 #
@@ -47,7 +47,7 @@
        # Provide the users module:
        variable version {0.4}
        package provide tcldrop::core $version
-       variable rcsid {$Id: core.tcl,v 1.26 2003/12/01 01:59:51 fireegl Exp $}
+       variable rcsid {$Id: core.tcl,v 1.27 2003/12/01 08:06:54 fireegl Exp $}
        # Initialize variables:
        variable Binds
        variable Timers
@@ -203,7 +203,6 @@
 # Use * for all channels, or - to specify that it's global-only.
 proc putloglev {levels channel text} {
        # Call all of the LOG binds here:
-       # This bind type was created in order to log to files and to consoles 
without being tied to those functions/modules directly.
        foreach b [binds log] {
                foreach {type flags mask count proc} $b {}
                if {[::tcldrop::CheckFlags $flags $levels] && [string match 
-nocase $mask $channel]} {
@@ -291,8 +290,8 @@
        # FixMe: This should check a list of registered bind types before 
accepting the bind.
        # Note: + or * means "anybody".  And - means "nobody".
        switch -- $flags {
-               {-} - {+} - {*} - {-|-} - {*|*} { set flags {+|+} }
-               {default} { if {![string match {*|*} $flags]} { set flags 
"$flags|-" } }
+               {-} - {+} - {*} - {-|-} - {*|*} { array set options [list flags 
{+|+}] }
+               {default} { if {![string match {*|*} $flags]} { array set 
options [list flags "$flags|-"] } }
        }
        variable Binds
        set Binds($type,$options(-priority),$proc,$mask) [array get options]
@@ -553,11 +552,6 @@
                # Note, the reason for importing the commands to both the 
tcldrop
                # and the global namespace is so that in case we're not running
                # in our own interp we won't disturb what's already there.
-               # FixMe: All modules need to be changed to use (for example):
-               #        ::tcldrop::bind
-               #        Instead of:
-               #        bind
-               #        That goes for ALL *core* tcldrop commands.
 
                # Load the corresponding .lang file:
                if {[addlang $::lang $module]} {
@@ -565,6 +559,16 @@
                } else {
                        catch { putlog "[format $::tcldrop::lang(0x210) 
$module]" }
                }
+               foreach b [binds load] {
+                       foreach {type flags mask count proc} $b {}
+                       if {[string match -nocase $mask $module]} {
+                               if {[catch { $proc $module } err]} {
+                                       putlog "Error in $proc: $err"
+                                       puterrlog "$::errorInfo"
+                               }
+                               ::tcldrop::countbind $type $mask $proc
+                       }
+               }
        }
 }
 
@@ -572,17 +576,22 @@
 proc checkmodule {module {version {}}} { loadmodule $module $version }
 
 proc unloadmodule {module} { set out {}
-       # FixMe: create a new bind called "unloadmod" or something,
-       #        so that modules can know when they're about to be unloaded.
-       #        They should return 0 if it's ok to continue with the rest of 
this proc.
-       #        If they return 1 then we shouldn't unload them (likely because 
they're required)
        if {[catch { namespace forget "tcldrop::${module}::*" }]} {
                set out [format $::tcldrop::lang(0x207)]
        } else {
                putlog "[format $::tcldrop::lang(0x206)] $module"
-
        }
        package forget "tcldrop-$module"
+       foreach b [binds unld] {
+               foreach {type flags mask count proc} $b {}
+               if {[string match -nocase $mask $module]} {
+                       if {[catch { $proc $module } err]} {
+                               putlog "Error in $proc: $err"
+                               puterrlog "$::errorInfo"
+                       }
+                       ::tcldrop::countbind $type $mask $proc
+               }
+       }
        set out
 }