egghelp.org community Forum Index
[ egghelp.org home | forum home ]
egghelp.org community
Discussion of eggdrop bots, shell accounts and tcl scripts.
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

"Tip of the day"
Goto page Previous  1, 2, 3, 4, 5  Next
 
Post new topic   Reply to topic    egghelp.org community Forum Index -> Tcl FAQ
View previous topic :: View next topic  
Author Message
user
 


Joined: 18 Mar 2003
Posts: 1452
Location: Norway

PostPosted: Fri May 26, 2006 10:13 am    Post subject: Reply with quote

De Kus wrote:
Code:
proc string2list {s {c "\n\t "}} {
   foreach i [split $s $c] {
      if {$i!=""} {lappend res $i}
   }
   set res
}

If you want to improove split, why not at least include all features of split? Smile

Yes..that's a good idea Smile but you should keep the line creating the result variable. making lappend create it is not a good idea (pass your proc an empty string)
_________________
Have you ever read "The Manual"?
Back to top
View user's profile Send private message
rosc2112
Revered One


Joined: 19 Feb 2006
Posts: 1454
Location: Northeast Pennsylvania

PostPosted: Fri May 26, 2006 11:23 am    Post subject: Reply with quote

Just to clarify, could you post the *final* string2list proc? The thread has gotten a bit confusing to this neophyte =)
Back to top
View user's profile Send private message
caesar
Ass Kicker


Joined: 14 Oct 2001
Posts: 3401
Location: Area 51

PostPosted: Fri May 26, 2006 2:37 pm    Post subject: Reply with quote

user wrote:

proc string2list s {
split [eval concat [split $s]]
}

That's the final one.
_________________
You may say anything about me, but don't misspell my name.
Back to top
View user's profile Send private message
demond
Revered One


Joined: 12 Jun 2004
Posts: 3073
Location: San Francisco, CA

PostPosted: Sat May 27, 2006 4:17 am    Post subject: Reply with quote

user wrote:

Try 'string2list {[exit]}' using that proc Razz The catch doesn't make any sense... RS must have created that proc before he learned Tcl Razz


where have you been? Smile

my fault I didn't quote DGP's remark right next to this thing:
Quote:

Note that this suffers from the same dangers as explained in the List well-formedness test above. Modifications for safety are left as an exercise for the reader (or the next Wiki visitor). You have been warned. - DGP

_________________
connection, sharing, dcc problems? click <here>
before asking for scripting help, read <this>
use [code] tag when posting logs, code
Back to top
View user's profile Send private message Visit poster's website
sKy
Op


Joined: 14 Apr 2005
Posts: 194
Location: Germany

PostPosted: Sat May 27, 2006 5:04 pm    Post subject: Reply with quote

I know the string2list problem. That`s how i handle it right now.

Code:
# i use this

proc lremove { listname string } {
   return [lsearch -all -inline -not -exact $listname $string]
}

# or you could use this aswell too (lower memory usage)

proc lremove1 { listname string } {
   upvar $listname _list
   set _list [lsearch -all -inline -not -exact $_list $string]
}

# just an example
set result [exec process.exe -v]

foreach line [split $result "\n"] {
   # the first line will look like:
   #     ImageName   PID Threads Priority CPU Owner
   set line [split $line]
   # this is returned
   # {} {} {} {} {} {} {} ImageName {} {} PID Threads Priority CPU Owner
   # all those pointless {} doesn`t make it more easy to handle this list for futher things
   # so we just remove them
   set line [lremove $line {}]
   # the result will be
   # ImageName PID Threads Priority CPU Owner
   # perfect for me ;)
   #
   # from here do whatever you want
}


Quote:
Note that this suffers from the same dangers as explained in the List well-formedness test above. Modifications for safety are left as an exercise for the reader (or the next Wiki visitor). You have been warned. - DGP

I don`t really understand this.
But my method should be secure.

Comments wanted.
_________________
socketapi | Code less, create more.
Back to top
View user's profile Send private message
demond
Revered One


Joined: 12 Jun 2004
Posts: 3073
Location: San Francisco, CA

PostPosted: Sat Jun 03, 2006 2:25 am    Post subject: Reply with quote

sKy wrote:

Code:
# i use this

proc lremove { listname string } {
   return [lsearch -all -inline -not -exact $listname $string]
}

this won't work on older Tcl versions (lower than 8.4)
Quote:

Quote:
Note that this suffers from the same dangers as explained in the List well-formedness test above. Modifications for safety are left as an exercise for the reader (or the next Wiki visitor). You have been warned. - DGP

I don`t really understand this.

double evaluation; see my post about that somewhere in the FAQ section ("Script security" thread or something)
_________________
connection, sharing, dcc problems? click <here>
before asking for scripting help, read <this>
use [code] tag when posting logs, code
Back to top
View user's profile Send private message Visit poster's website
NoZparker
Voice


Joined: 16 Feb 2004
Posts: 34

PostPosted: Wed Jun 14, 2006 5:21 pm    Post subject: Don't Work vs Does Work Reply with quote

while :-
rm path/filename <--- does not work (to delete a file)
and
mv path/filename <--- does not work (to move a file)

file delete -- path/filename <--- does work
and
file copy -- path/filename(source) path(destination) <--- does work

so if your commands don't work do not despair
try :-

http://www.tcl.tk/man/tcl8.4/TclCmd/contents.htm
in the words of those that are here all the time RTFM

this link is hidden on this sight somewhere
_________________
It's times like this I wished I had listened to What my dad used to say. Can't say what it was I never listened.
Back to top
View user's profile Send private message
demond
Revered One


Joined: 12 Jun 2004
Posts: 3073
Location: San Francisco, CA

PostPosted: Thu Jun 15, 2006 1:29 am    Post subject: Reply with quote

hah, a candid signature; if you had listened to your dad, perhaps you wouldn't be posting off-topic; what you had to say is hardly a Tcl tip, let alone a trick
_________________
connection, sharing, dcc problems? click <here>
before asking for scripting help, read <this>
use [code] tag when posting logs, code
Back to top
View user's profile Send private message Visit poster's website
NoZparker
Voice


Joined: 16 Feb 2004
Posts: 34

PostPosted: Thu Jun 15, 2006 1:42 am    Post subject: Reply with quote

Quote:
http://www.tcl.tk/man/tcl8.4/TclCmd/contents.htm
in the words of those that are here all the time RTFM

Is A tip

Quote:
hah, a candid signature; if you had listened to your dad, perhaps you wouldn't be posting off-topic; what you had to say is hardly a Tcl tip, let alone a trick

Is a critisism

and who do you think asked for the tip of the day in the first place.
Please keep critisisms to a private message.
_________________
It's times like this I wished I had listened to What my dad used to say. Can't say what it was I never listened.
Back to top
View user's profile Send private message
demond
Revered One


Joined: 12 Jun 2004
Posts: 3073
Location: San Francisco, CA

PostPosted: Thu Jun 15, 2006 11:23 am    Post subject: Reply with quote

let me explain to you why it's NOT a tip

UNIX/Linux shell commands have nothing to do with Tcl; and simply pointing out some Tcl commands that have similar functionality does not constitute a tip in any way (a tip is, mind you, a helpful hint - which your RTFM statement is not)

moreover, apparently you have no idea what you are talking about; if the shell commands don't work on some file - because of permission modes/insufficient privileges - Tcl file commands won't work either

capisce?
_________________
connection, sharing, dcc problems? click <here>
before asking for scripting help, read <this>
use [code] tag when posting logs, code
Back to top
View user's profile Send private message Visit poster's website
user
 


Joined: 18 Mar 2003
Posts: 1452
Location: Norway

PostPosted: Wed Dec 20, 2006 2:52 pm    Post subject: interactive event loop in tclsh Reply with quote

Here's some code that may be useful if you want to test event based code in tclsh:
Code:
# enter the event loop:
proc eventloop {} {
   global stdin waitv
   puts -nonewline "Type \"exit\" to exit the event loop\n% "
   flush stdout
   fileevent stdin readable stdin
   set stdin ""
   vwait waitv
   unset waitv
   unset stdin
   fileevent stdin readable {}
}
# read and execute input (with verbose error reporting)
proc stdin {} {
   global stdin
   if {[info complete [append stdin [gets stdin]]]} {
      if {$stdin=="exit"} {
         set ::waitv 1
      } {
         if {[catch {uplevel #0 $stdin} result]} {
            global errorInfo
            puts -nonewline "[join [lrange [split $errorInfo \n] 0 end-5] \n]\n% "
         } elseif {$result!=""} {
            puts -nonewline "$result\n% "
         } {
            puts -nonewline "% "
         }
         flush stdout
         set stdin ""
      }
   } {
      append stdin \n
   }
}
# you'll probably want this proc too:
proc bgerror err {
   puts "bgError: $err"
}

...just invoke "eventloop" and continue working Smile
_________________
Have you ever read "The Manual"?
Back to top
View user's profile Send private message
user
 


Joined: 18 Mar 2003
Posts: 1452
Location: Norway

PostPosted: Fri Dec 29, 2006 8:59 pm    Post subject: Reply with quote

Here's a small eggdrop script (pretty similar to the previous one) that lets you emulate tclsh on your partyline.
Code:
namespace eval ::eggsh {

   bind dcc n sh ::eggsh::1

   variable v

   proc 1 {h i a} {
      # hack to honor the "must-be-owner" setting:
      *dcc:tcl $h $i [list ::eggsh::2 $h $i $a]
   }

   proc 2 {h i a} {
      set ::eggsh::v($i) ""
      control $i [list ::eggsh::3 $h]
      return "Type 'exit' to return to the real world."
   }

   proc 3 {h i a} {
      if {$a==""} {
         unset ::eggsh::v($i)
      } {
         upvar 0 ::eggsh::v($i) buf
         if {[info complete [append buf $a]]} {
            if {$buf=="exit"} {
               unset buf
               return 1
            } {
               if {[catch {uplevel #0 $buf} res]} {
                  putdcc $i [join [lrange [split $::errorInfo \n] 0 end-5] \n]
               } {
                  putdcc $i $res
               }
               set buf ""
            }
         } {
            append buf \n
         }
      }
      return 0
   }

   # EDIT: Added this proc for stupid irc clients that
   # are incapable of displaying the tab character (\x09)
   # Remove it if you don't need it.
   proc putdcc {i a} {::putdcc $i [string map {\t "    "} $a]}

}

just type ".sh" and start pasting/writing code directly into your bot's interpreter Smile
Here's a sample session:
Code:
[02:08:55] <user> .sh
[02:08:55] <bot> Tcl: Type 'exit' to return to the real world.
[02:09:07] <user> proc errortest {} {
[02:09:08] <user> invalid
[02:09:09] <user> }
[02:09:09] <bot>
[02:09:12] <user> errortest
[02:09:12] <bot> invalid command name "invalid"
[02:09:12] <bot>     while executing
[02:09:12] <bot> "invalid"
[02:09:12] <bot>     (procedure "errortest" line 2)
[02:09:17] <user> exit
[02:09:17] <bot> *** user has joined the party line.
[02:09:17] <bot> You have no messages.


EDIT: typo
_________________
Have you ever read "The Manual"?


Last edited by user on Tue Jan 02, 2007 2:29 pm; edited 1 time in total
Back to top
View user's profile Send private message
user
 


Joined: 18 Mar 2003
Posts: 1452
Location: Norway

PostPosted: Tue Jan 02, 2007 2:21 pm    Post subject: Reply with quote

'stripcodes' for older eggdrops:
Code:
if {![llength [info commands stripcodes]]} {
   proc stripcodes {flags string} {
      upvar 0 ::stripcodes($flags) rule
      if {![info exists rule]} {
         set rule [string map {
            b \x02
            c "\x03(?:\[0-9\]{1,2}(?:,\[0-9\]{1,2})?)?"
            r \x16
            u \x1F
            a "\x1B\\\[(?:\[0-9\]{1,2};)+m"
            g \x07
         } [join [split $flags ""] |]]
      }
      regsub -all $rule $string {} string
      set string
   }
}

I'm not sure what ANSI stuff the eggdrop command strips off - my proc only takes care of colors.
_________________
Have you ever read "The Manual"?
Back to top
View user's profile Send private message
caesar
Ass Kicker


Joined: 14 Oct 2001
Posts: 3401
Location: Area 51

PostPosted: Tue Jan 02, 2007 4:08 pm    Post subject: Reply with quote

You never cease to amaze us user. Keep up the good work. Really appreciated. Smile
_________________
You may say anything about me, but don't misspell my name.
Back to top
View user's profile Send private message
user
 


Joined: 18 Mar 2003
Posts: 1452
Location: Norway

PostPosted: Wed Jan 03, 2007 8:23 am    Post subject: Reply with quote

Some handy coding/debugging tools:

pp - print proc
pv - print variable
pn - print namespace (with procs, variables and proper indentation)
indent - apply indentation based on open/close braces

Code:
### pp procName ?in namespace?
# proc: fully qualified proc name (or relative to the global namespace)
# inNS: to be evaluated inside a namespace? 1/0
#       (if '1', output name will be 'namespace tail $fullName')
proc pp {proc {inNS 0}} {
   set args [list]
   foreach arg [info args $proc] {
      lappend args [if {[info default $proc $arg val]} {list $arg $val} {list $arg}]
   }
   list proc [expr {$inNS?[namespace tail $proc]:$proc}] $args [info body $proc]
}

### pv variableName ?verbose arrays? ?in namespace?
# var: fully qualified variable name (or relative to the global namespace)
# verbose: verbose printing of arrays with one or more elements? 1/0
# inNS: to be evaluated inside a namespace? 1/0
#       (if '1', output name will be 'namespace tail $fullName'
#        output will contain 'variable $varName')
proc pv {var {verbose 0} {inNS 0}} {
   upvar 1 $var Var
   set name [if {$inNS} {namespace tail $var} {set var}]
   if {[array exists Var]} {
      set out [if {$inNS} {list [list variable $name]} list]
      if {$verbose&&[array size Var]} {
         foreach {key val} [array get Var] {
            lappend out [list set ${name}($key) $val]
         }
      } {
         lappend out [list array set $name [array get Var]]
      }
      join $out \n
   } elseif {[info exists Var]} {
      if {$inNS} {
         list variable $name $Var
      } {
         list set $name $Var
      }
   }
}

### pn namespaceName ?maxDepth?
# name: root namespace
# depth: how many levels of recursion? (special values: 0=none, -1=all)
proc pn {{name ::} {depth 0}} {
   set name [namespace inscope $name {namespace current}]
   if {[string match *:: $name]} {set mask $name*} {set mask ${name}::*}
   set code {}
   foreach var [info vars $mask] {
      lappend code [pv $var 1 1]
   }
   foreach proc [info procs $mask] {
      lappend code [pp $proc 1]
   }
   if {$depth!=0} {
      incr depth -1
      foreach ns [namespace children $name] {
         lappend code [pn $ns $depth]
      }
   }
   list namespace eval [namespace tail $name] [indent \n[join $code \n] \t 1]\n
}

### indent code ?dentChars? ?startLevel?
# code: valid tcl code
# dent: character(s) added per level of indentation
# curr: start level
proc indent {code {dent \t} {curr 0}} {
   foreach line [split $code[set code {}] \n] {
      set escd 0
      set next 0
      foreach char [split $line ""] {
         if {$escd} {set escd 0; continue}
         switch -- $char {
            \\ {set escd 1}
            \{ {incr next 1}
            \} {if {$next} {incr next -1} {incr curr -1}}
         }
      }
      lappend code [string repeat $dent $curr][string trimleft $line]
      incr curr $next
   }
   join $code \n
}

# Test: dump EVERY namespace in your interpreter to a file:
proc dump {{file dump.tcl}} {
   set f [open $file w]
   puts $f [pn :: -1]
   close $f
   puts "check $file"
}
dump

_________________
Have you ever read "The Manual"?
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    egghelp.org community Forum Index -> Tcl FAQ All times are GMT - 4 Hours
Goto page Previous  1, 2, 3, 4, 5  Next
Page 4 of 5

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Forum hosting provided by Reverse.net

Powered by phpBB © 2001, 2005 phpBB Group
subGreen style by ktauber