203 |
# Use * for all channels, or - to specify that it's global-only. |
# Use * for all channels, or - to specify that it's global-only. |
204 |
proc putloglev {levels channel text} { |
proc putloglev {levels channel text} { |
205 |
# Call all of the LOG binds here: |
# 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. |
|
206 |
foreach b [binds log] { |
foreach b [binds log] { |
207 |
foreach {type flags mask count proc} $b {} |
foreach {type flags mask count proc} $b {} |
208 |
if {[::tcldrop::CheckFlags $flags $levels] && [string match -nocase $mask $channel]} { |
if {[::tcldrop::CheckFlags $flags $levels] && [string match -nocase $mask $channel]} { |
290 |
# FixMe: This should check a list of registered bind types before accepting the bind. |
# FixMe: This should check a list of registered bind types before accepting the bind. |
291 |
# Note: + or * means "anybody". And - means "nobody". |
# Note: + or * means "anybody". And - means "nobody". |
292 |
switch -- $flags { |
switch -- $flags { |
293 |
{-} - {+} - {*} - {-|-} - {*|*} { set flags {+|+} } |
{-} - {+} - {*} - {-|-} - {*|*} { array set options [list flags {+|+}] } |
294 |
{default} { if {![string match {*|*} $flags]} { set flags "$flags|-" } } |
{default} { if {![string match {*|*} $flags]} { array set options [list flags "$flags|-"] } } |
295 |
} |
} |
296 |
variable Binds |
variable Binds |
297 |
set Binds($type,$options(-priority),$proc,$mask) [array get options] |
set Binds($type,$options(-priority),$proc,$mask) [array get options] |
552 |
# Note, the reason for importing the commands to both the tcldrop |
# Note, the reason for importing the commands to both the tcldrop |
553 |
# and the global namespace is so that in case we're not running |
# and the global namespace is so that in case we're not running |
554 |
# in our own interp we won't disturb what's already there. |
# 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. |
|
555 |
|
|
556 |
# Load the corresponding .lang file: |
# Load the corresponding .lang file: |
557 |
if {[addlang $::lang $module]} { |
if {[addlang $::lang $module]} { |
559 |
} else { |
} else { |
560 |
catch { putlog "[format $::tcldrop::lang(0x210) $module]" } |
catch { putlog "[format $::tcldrop::lang(0x210) $module]" } |
561 |
} |
} |
562 |
|
foreach b [binds load] { |
563 |
|
foreach {type flags mask count proc} $b {} |
564 |
|
if {[string match -nocase $mask $module]} { |
565 |
|
if {[catch { $proc $module } err]} { |
566 |
|
putlog "Error in $proc: $err" |
567 |
|
puterrlog "$::errorInfo" |
568 |
|
} |
569 |
|
::tcldrop::countbind $type $mask $proc |
570 |
|
} |
571 |
|
} |
572 |
} |
} |
573 |
} |
} |
574 |
|
|
576 |
proc checkmodule {module {version {}}} { loadmodule $module $version } |
proc checkmodule {module {version {}}} { loadmodule $module $version } |
577 |
|
|
578 |
proc unloadmodule {module} { set out {} |
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) |
|
579 |
if {[catch { namespace forget "tcldrop::${module}::*" }]} { |
if {[catch { namespace forget "tcldrop::${module}::*" }]} { |
580 |
set out [format $::tcldrop::lang(0x207)] |
set out [format $::tcldrop::lang(0x207)] |
581 |
} else { |
} else { |
582 |
putlog "[format $::tcldrop::lang(0x206)] $module" |
putlog "[format $::tcldrop::lang(0x206)] $module" |
|
|
|
583 |
} |
} |
584 |
package forget "tcldrop-$module" |
package forget "tcldrop-$module" |
585 |
|
foreach b [binds unld] { |
586 |
|
foreach {type flags mask count proc} $b {} |
587 |
|
if {[string match -nocase $mask $module]} { |
588 |
|
if {[catch { $proc $module } err]} { |
589 |
|
putlog "Error in $proc: $err" |
590 |
|
puterrlog "$::errorInfo" |
591 |
|
} |
592 |
|
::tcldrop::countbind $type $mask $proc |
593 |
|
} |
594 |
|
} |
595 |
set out |
set out |
596 |
} |
} |
597 |
|
|