[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Tcldrop/CVS] tcldrop/modules dcc.tcl
From: |
Philip Moore |
Subject: |
[Tcldrop/CVS] tcldrop/modules dcc.tcl |
Date: |
Wed, 09 Jul 2003 02:09:55 -0400 |
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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Tcldrop/CVS] tcldrop/modules dcc.tcl,
Philip Moore <=