Code: Select all
rename theProc ::Code: Select all
% array set "" {0 a 1 b}
% list $(0) $(1)
a bCode: Select all
% array set "" {"" exit}
% $()
Code: Select all
rename theProc ::Code: Select all
% array set "" {0 a 1 b}
% list $(0) $(1)
a bCode: Select all
% array set "" {"" exit}
% $()
Code: Select all
# A test proc (with a stupid name) that logs all arguments passed to it: 
<user> .tcl proc \{ args {putlog "args: $args"} 
<bot> Tcl: 
# Trying to invoke it the wrong way: 
<user> .tcl bind dcc n demo \{ 
<bot> Tcl: demo 
<user> .demo 
<bot> [16:54] Tcl error [{]: missing close-brace 
# The right way: 
<user> .tcl bind dcc n demo [list \{] 
<bot> Tcl: demo 
<user> .demo 
<bot> [16:54] args: user 8 {} 
# Adding an argument: 
<user> .tcl bind dcc n demo [list \{ newFirstArg] 
<bot> Tcl: demo 
<user> .demo 
<bot> [16:54] args: newFirstArg user 8 {}
Code: Select all
if {![llength [info procs dnslookup]]&&[llength [info commands dnslookup]]} {
	rename dnslookup __dnslookup 
	proc dnslookup {addr code} {eval [list __dnslookup $addr __dnslookedup] $code}
	proc __dnslookedup {0 1 2 args} {uplevel #0 [concat $args [list $0 $1 $2]]}
}
Code: Select all
regexp {aaa|bbb|ccc|ddd|eee|fff|ggg|hhh|iii|jjj|kkk} $string
#this becomes annoyling long and not efficient enough
#a smaller way of accomplishing the exact same this is:
regexp {([a-z])\1\1+} $string
#even the + is redudant in my oppinion as for what I tested, so:
regexp {([a-z])\1\1} $string
Code: Select all
<awyeah> .tcl regexp {([a-z])\1\1} "baxcd"
<adapter> Tcl: 0
<awyeah> .tcl regexp {([a-z])\1\1} "baxxcd"
<adapter> Tcl: 0
<awyeah> .tcl regexp {([a-z])\1\1} "baxxxxcd"
<adapter> Tcl: 1
<awyeah> .tcl regexp {([a-z])\1\1} "baxxxcd"
<adapter> Tcl: 1
<awyeah> .tcl regexp {([a-z])\1\1} "baxxxxxcd"
<adapter> Tcl: 1
#for the + sign
<awyeah> .tcl regexp {([a-z])\1\1+} "baxxcd"
<adapter> Tcl: 0
<awyeah> .tcl regexp {([a-z])\1\1+} "baxxxcd"
<adapter> Tcl: 1
<awyeah> .tcl regexp {([a-z])\1\1+} "baxxxxcd"
<adapter> Tcl: 1
([a-z])\1 <=-- Means that letter is present 2 times or more
([a-z])\1\1 <=-- Means that letter is present 3 times or more
and so on...
Actually ([a-z])\1 means any alphabet repeated exactly 2 consecutive times and not 2 or more. If you add a + (which means 1 or more) then you can consider ([a-z])\1+ as any alphabet repeated exactly 2 times once or more (i.e. aa, aaaa, aaaaaa). If you're wondering why it matches 'aaa' for example, that's because 'a' is repeated 2 consecutive times at least once.awyeah wrote:([a-z])\1 <=-- Means that letter is present 2 times or more
([a-z])\1\1 <=-- Means that letter is present 3 times or more
and so on...
(*) When an error is found the bot gives you an error and doesn't load the script.
(*) When no error is found in the script a message similar to the one below will be displayed:
Script: tcldebug.tcl - Size: 3 kb - Status: OK
Code: Select all
set lflags "n"
set lscriptsdir "scripts/"
set ltrigger "!"
bind pub $lflags ${ltrigger}load load:file
proc load:file {nick host hand chan text} {
    global lscriptsdir ltrigger
    set file [lindex [split $text] 0]
    if {$file == ""} {
        putserv "PRIVMSG $nick :-(Load)- ${ltrigger}load <scriptname.tcl> -(Info)-"
        return 0
    } elseif {![file exists [file join $lscriptsdir $file]]} {
        putserv "PRIVMSG $nick :-(Load)- Sorry $file doesn't exist -(Info)-"
        return 0
    } else {
        set kbsize [expr {[file size [file join $lscriptsdir/$file]] / 1024.0}]
        if {[catch {uplevel {source [file join $lscriptsdir $file]}} error]} {
            putserv "PRIVMSG $nick :-(Load)- Script: $file Size: $kbsize kb Status: Error -(Info)-"
            putserv "PRIVMSG $nick :-(Load)- $error -(Info)-"
        } else {
            putserv "PRIVMSG $nick :-(Load)- Script: $file - Size: $kbsize kb - Status: OK -(Info)-"
        }
    }
}
You need to set the lscriptsdir to your own dir
You can also change the lflags to whatever you want
Example: your trigger is "!"
!load tcldebug.tcl
 There are backdoors everywhere.
 There are backdoors everywhere.
Well that's a risk I guess they would have to take. Actually I made it for scripters, I myself sometimes miss a brace or two when I write a new script with long procs, so atleast the bot wouldn't crash and I can fix the script and then load it back into the bot. Farewell I'm off to sleep then. Gnitenml375 wrote:Allowing ppl to load arbitrary scripts is a very, very bad idea. Assuming you run your eggdrop on a commercial shell, anyone else on that shell could place a malicious script on the system, and, if the hostmasks are'nt restrictive enough use this loader to load the script in question...

Code: Select all
source [file join $lscriptsdir $file]Code: Select all
if {[catch {uplevel {source [file join $lscriptsdir $file]}} error]} {
### Change to:
if {[catch {uplevel "source [file join $lscriptsdir $file]"} error]} {Code: Select all
proc myproc {nick uhost hand chan text} {
 putserv "NOTICE @$chan :my_text_here"
}
*** Note: You can even use /notice @#channel with mIRC and it will work just fine.People generally use the command /ONOTICE on clients such as mIRC to send opnotices, but with the eggdrop its a bit different.
=> Use a normal NOTICE followed by a "@" infront of your channel name, e.g. @#mychan to send an opnotice (send a notice to all channel ops) with your eggdrop.
Code: Select all
proc msg {dest data} {
	set len [expr {512-[string len ":$::botname PRIVMSG $dest :\r\n"]}]
	foreach line [wordwrap $data $len] {
		puthelp "PRIVMSG $dest :$line"
	}
}
# wordwrap proc that accepts multiline data
# (empty lines will be stripped because there's no way to relay them via irc)
proc wordwrap {data len} {
	set out {}
	foreach line [split [string trim $data] \n] {
		set curr {}
		set i 0
		foreach word [split [string trim $line]] {
			if {[incr i [string len $word]]>$len} {
				lappend out [join $curr]
				set curr [list $word]
				set i [string len $word]
			} {
				lappend curr $word
			}
			incr i
		}
		if {[llength $curr]} {
			lappend out [join $curr]
		}
	}
	set out
}
 hope someone finds it useful
 hope someone finds it usefulCode: Select all
proc makenice {tmp size} {
  set mx [llength $tmp]
  set current 0
  set total 0
   foreach t $tmp {
    set total [expr {$total+1}]
    if {($mx > $total)} {
     lappend out "$t"
     set current [expr {$current+1}]
      if {($current == $size)} {
        puts "$out"
        set current 0
        set out [list]
      }
    } else {
     lappend out [join [lrange [split $tmp] [expr {$total-1}] $mx]]
      puts "$out"
    }
   }
} 
 Code: Select all
% llength $mylist
17
% makenice $mylist 6
line1 line2 line3 line4 line5 line6
line7 line8 line9 line10 line11 line12
line13 line14 line15 line16 line17
%Code: Select all
proc makenice {text size} {
  set mx [llength $text]
  set current 0
  set zap $size
  set total 0
  set sent 0
  set tidy [expr {$mx / $zap}]
   foreach t $text {
    if {($total != $mx)} {
     set total [expr {$total+1}]
    } else {
     break
    }
    if {($sent == $tidy)} {
     set out [join [lrange [split $text] $total $mx]]
     puts "$out"
     break
    }
     if {($current == $zap)} {
      puts "$out"
       set sent [expr {$sent+1}]
       set current 0
       set out [list]
     } else {
      lappend out "$t"
       set current [expr {$current+1}]
     }
   }
}Code: Select all
% makenice "[lrepeat 17 "bunny-rabbits"]" "6"
bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits
bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits bunny-rabbits
bunny-rabbits bunny-rabbits
%Code: Select all
llength $text
...
foreach t $text {Code: Select all
set total [expr {$total+1}] => incr totalCode: Select all
if {($total != $mx)} {
     set total [expr {$total+1}]
    } else {
     break
    }Code: Select all
proc makenice {text size} {
  set items [split $text]
  set length [llength $items]
  incr size -1
  for {set i 0} {$i <$length} {incr i} {
    puts [join [lrange $items $i [incr i $size]]]
  }
}