[Tcldrop/CVS] tcldrop/modules dcc.tcl

[Philip Moore]

CVSROOT:        /cvsroot/tcldrop
Module name:    tcldrop
Branch:         
Changes by:     Philip Moore <address@hidden>   03/07/09 02:09:55

Modified files:
        modules        : dcc.tcl 

Log message:
        Fixed the bug that always made it say "What?  You need '.help'" even
        when it tiggered a DCC bind.  Also fixed another dcc related bug..

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

Patches:
Index: tcldrop/modules/dcc.tcl
diff -u tcldrop/modules/dcc.tcl:1.5 tcldrop/modules/dcc.tcl:1.6
--- tcldrop/modules/dcc.tcl:1.5 Wed May 28 15:47:53 2003
+++ tcldrop/modules/dcc.tcl     Wed Jul  9 02:09:55 2003
@@ -1,24 +1,24 @@
 # dcc.tcl --
 #
-# $Id: dcc.tcl,v 1.5 2003/05/28 19:47:53 fireegl Exp $
+# $Id: dcc.tcl,v 1.6 2003/07/09 06:09:55 fireegl Exp $
 #
 # Copyright (C) 2003 FireEgl (Philip Moore) <address@hidden>
-# 
+#
 # This program is free software; you can redistribute it and/or
 # modify it under the terms of the GNU General Public License
 # as published by the Free Software Foundation; either version 2
 # of the License, or (at your option) any later version.
-# 
+#
 # This program is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
-# 
+#
 # You should have received a copy of the GNU General Public License
 # along with this program (see gpl.txt); if not, write to the
 # Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  
02111-1307, USA.
 # Or visit http://www.GNU.Org/licenses/gpl.html
-# 
+#
 # The author of this project can be reached at address@hidden
 # Or can be found on IRC (EFNet or FreeNode) as FireEgl.
 #
@@ -32,7 +32,7 @@
        # Provide the users module:
        variable version {0.2}
        package provide tcldrop::dcc $version
-       variable rcsid {$Id: dcc.tcl,v 1.5 2003/05/28 19:47:53 fireegl Exp $}
+       variable rcsid {$Id: dcc.tcl,v 1.6 2003/07/09 06:09:55 fireegl Exp $}
        #checkmodule console
        # Export all the commands that should be available to 3rd-party 
scripters:
        namespace export dcclist listen putdcc getchan setchan console echo 
strip idx2hand hand2idx
@@ -212,7 +212,7 @@
        foreach {a d} [::tcldrop::idx::Info $idx] { array set idxinfo $d }
        if {$status == {ok}} {
                ::tcldrop::idx::ChInfo $idx [list ident $response remote 
address@hidden(hostname)]
-               
+
        } else {
                ::tcldrop::idx::ChInfo $idx [list ident -telnet remote 
address@hidden(hostname)]
        }
@@ -326,9 +326,7 @@
                                        # it to simulate an ircII client.  =D
                                        if {[string index $line 0] == {.}} {
                                                # Do the DCC binds:
-                                               if {![DCC $chatinfo(handle) 
$idx $line]} {
-                                                       putidx $idx {What?  You 
need '.help'  (FixMe: .help doesn't work.)}
-                                               }
+                                               DCC $chatinfo(handle) $idx $line
                                        } else {
                                                # FixMe: CHAT binds get called 
here:
                                                #CHAT $chatinfo(handle) 
$channel $line
@@ -350,7 +348,7 @@
        # FixMe: close the socket and unregister the idx.
        fileevent $sock readable {}
        close $sock
-       
+
 }
 
 proc ::tcldrop::dcc::listen {port type {mask {}} {flag {pub}}} {
@@ -382,21 +380,22 @@
 proc ::tcldrop::dcc::DCC {handle idx arg} {
        # retval will be the number of binds that were triggered..
        set retval 0
-       set cmd [string trim [string range $arg 1 [string first { } $arg]]]
-       set arg [string trim [string range $arg [string first { } $arg] end]]
+       set arg [split $arg]
+       set cmd [string range [lindex $arg 0] 1 end]
+       set arg [join [lrange $arg 1 end]]
        foreach a [binds dcc] {
                foreach {type flags mask count proc} $a {}
                if {[string equal -nocase $cmd $mask] && [matchattr $handle 
$flags]} {
+                       incr retval
                        if {[catch { $proc $handle $idx $arg } err]} {
                                putlog "error in script: $proc: $err"
                        } elseif {[string equal $err {1}]} {
                                # Abort processing further binds if they return 
1.
                                break
-                       } else {
-                               incr retval
                        }
                }
        }
+       if {$retval == 0} { putidx $idx {What?  You need '.help'} }
        set retval
 }
 
@@ -430,12 +429,29 @@
 }
 
 # Here goes all the DCC binds:
-bind dcc n tcl ::tcldrop::dcc::tcl
-proc ::tcldrop::dcc::tcl {handle idx text} {
-       if {[catch { uplevel #0 $text } out]} {
+bind dcc n tcl ::tcldrop::dcc::TCL
+proc ::tcldrop::dcc::TCL {handle idx text} {
+       if {[catch { uplevel \#0 $text } out]} {
                set out "TCL error: $out"
        } else {
                set out "Tcl: $out"
        }
        putdcc $idx $out
 }
+
+bind dcc n set ::tcldrop::dcc::SET
+proc ::tcldrop::dcc::SET {handle idx text} {
+       set variable [lindex [set text [split $text]] 0]
+       set value [join [lrange $text 1 end]]
+       if {[catch { uplevel \#0 [list set $variable $value] } out]} {
+               set out "Error: $out"
+       } else {
+               set out "Set $variable to: $value"
+       }
+       putdcc $idx $out
+}
+
+bind dcc - help ::tcldrop::dcc::HELP
+proc ::tcldrop::dcc::HELP {handle idx text} {
+       putdcc $idx "There's no help here!  FixMe!"
+}
\ No newline at end of file