[Tcldrop/CVS] tcldrop/modules core.tcl

[Philip Moore]

CVSROOT:        /cvsroot/tcldrop
Module name:    tcldrop
Branch:         
Changes by:     Philip Moore <address@hidden>   03/11/15 21:53:25

Modified files:
        modules        : core.tcl 

Log message:
        Added string2list and slindex/slrange/sllength tcl commands.

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

Patches:
Index: tcldrop/modules/core.tcl
diff -u tcldrop/modules/core.tcl:1.16 tcldrop/modules/core.tcl:1.17
--- tcldrop/modules/core.tcl:1.16       Fri Nov 14 10:58:47 2003
+++ tcldrop/modules/core.tcl    Sat Nov 15 21:53:24 2003
@@ -1,6 +1,6 @@
 # core.tcl --
 #
-# $Id: core.tcl,v 1.16 2003/11/14 15:58:47 fireegl Exp $
+# $Id: core.tcl,v 1.17 2003/11/16 02:53:24 fireegl Exp $
 #
 # Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
 #
@@ -47,13 +47,13 @@
        # Provide the users module:
        variable version {0.3}
        package provide tcldrop::core $version
-       variable rcsid {$Id: core.tcl,v 1.16 2003/11/14 15:58:47 fireegl Exp $}
+       variable rcsid {$Id: core.tcl,v 1.17 2003/11/16 02:53:24 fireegl Exp $}
        # Initialize variables:
        variable Binds
        variable Timers
        variable TimerIDCount 1
        # Export all the commands that should be available to 3rd-party 
scripters:
-       namespace export bind unbind binds timer utimer killtimer killutimer 
timers utimers maskhost isbotnetnick
+       namespace export bind unbind binds timer utimer killtimer killutimer 
timers utimers maskhost isbotnetnick logfile
 }
 
 # Add our modules directory to the package require search path:
@@ -95,6 +95,19 @@
        clock format $time -format $format
 }
 
+# Note: string2list and slindex/slrange/sllength are used so that we can 
ignore extra white space in strings and still deal with special characters.
+proc ::tcldrop::string2list {string} {
+       if {[catch { eval list $string } res]} {
+               set res [list]
+               foreach i [split $string] { if {$i != {}} { lappend res $i } }
+       }
+       set res
+}
+
+proc ::tcldrop::slindex {string index} { lindex [string2list $string] $index }
+proc ::tcldrop::slrange {string start {end {end}}} { lrange [string2list 
$string] $start $end }
+proc ::tcldrop::sllength {string} { llength [string2list $string] }
+
 # FixMe: This should also support weeks, months, and years..
 proc duration {seconds} { set timeatoms [list]
        if {[catch {
@@ -155,8 +168,13 @@
        addlang {english}
 }
 
-proc logfile {levels channel filename} {
+proc ::tcldrop::logfile {levels channel filename} {
        # FixMe: Complete this.
+       bind log $levels $channel ::tcldrop::LogFile
+}
+
+proc ::tcldrop::LogFile {levels channel text} {
+
 }
 
 ### These are the levels (aka modes) that are used both by logfiles and 
consoles:
@@ -202,8 +220,8 @@
 proc putdebuglog {text {channel {-}}} { putloglev d $channel $text }
 
 proc bgerror {args} {
-puts $args
-puts $::errorInfo
+       ::tcldrop::Stdout - - "(bgerror) $args"
+       ::tcldrop::Stdout - - $::errorInfo
 }
 
 # Flag handling, returns 1 if there's a match, 0 if there's not.
@@ -456,17 +474,12 @@
 # And because [namespace import] imports into the current namespace.
 # FixMe: We need to keep up with what modules are loaded, and their versions.
 proc loadmodule {module {version {}}} {
-       # FixMe: The Tcl approved way for the packages to be named are 
(example):
-       #        tcldrop::users::arraydb
-       #        And NOT like we currently have it:
-       #        tcldrop-users-arraydb
-       #        It would be best (appearance wise) if they were all changed to 
be more like a standard Tcl package.
        if {(($version != {}) && ([catch { package require "tcldrop::${module}" 
$version } err])) || ([catch { package require "tcldrop::$module" } err])} {
                putlog "[format $::tcldrop::lang(0x209)] $module $version: $err"
                puterrlog "$::errorInfo"
        } else {
                variable Modules
-               if {[info exists "::tcldrop::${module}::version"]} { set modver 
[set "::tcldrop::${module}::version"] } else { set modver 0.0 }
+               if {[info exists "::tcldrop::${module}::version"]} { set modver 
[set "::tcldrop::${module}::version"] } else { set modver {0.0} }
                set Modules($module) $modver
                # Import the commands...
                # This imports them into the tcldrop namespace:
@@ -494,7 +507,6 @@
 # FixMe: checkmodule should do the same as loadmodule, except it shouldn't 
complain if the module is already loaded.
 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.
@@ -518,7 +530,7 @@
                foreach {type flags mask count proc} $b {}
                if {[string equal -nocase $event $mask]} {
                        if {[catch { $proc $event } err]} {
-                               putlog "error in $proc:\n$::errorInfo"
+                               putlog "error running $proc 
$event:\n$::errorInfo"
                        }
                }
        }
@@ -534,20 +546,6 @@
        # FixMe: exit should run [tcldrop stop name] in the interp above this 
one.
        exit 0
 }
-
-# Encrypts $password:
-# Note, most of the comments in this proc are by address@hidden
-proc null_encpass {password} {
-       # FixMe: This should return the password as a crypt.
-       # Well here we have several possible solutions, we can load the base64 
lib, or we can source
-       # the md5.tcl file .... or we have to make a blowfish module ;) --- 
Papillon
-       # With base64 encoding we can decode it later if wanted
-       # set password [::base64::encode -maxlen 53 -wrapchar j $password]
-       # with md5 we can't decode it.. but then again.. anyone else will have 
a hard time decoding it aswell ;)
-       # set password [::md5::hmac $password $password]
-       return $password
-}
-
 
 # Rehash, just like in Eggdrop, it (re)loads the config.
 proc rehash {{type {}}} {