| View previous topic :: View next topic |
| Author |
Message |
user
Joined: 18 Mar 2003
Posts: 1452
Location: Norway
|
 Posted: Fri May 26, 2006 10:13 am Post subject: |
 |
|
| 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?  |
Yes..that's a good idea 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 |
|
 |
rosc2112
Revered One
Joined: 19 Feb 2006
Posts: 1454
Location: Northeast Pennsylvania
|
| Posted: Fri May 26, 2006 11:23 am Post subject: |
|
|
| Just to clarify, could you post the *final* string2list proc? The thread has gotten a bit confusing to this neophyte =) |
|
| Back to top |
|
|
caesar
Mint Rubber
Joined: 14 Oct 2001
Posts: 3583
Location: Mint Factory
|
| Posted: Fri May 26, 2006 2:37 pm Post subject: |
|
|
| user wrote: |
proc string2list s {
split [eval concat [split $s]]
}
|
That's the final one.
_________________
I tawt I taw a puddy tat! |
|
| Back to top |
|
|
demond
Revered One
Joined: 12 Jun 2004
Posts: 3073
Location: San Francisco, CA
|
| Posted: Sat May 27, 2006 4:17 am Post subject: |
|
|
| user wrote: |
Try 'string2list {[exit]}' using that proc  The catch doesn't make any sense... RS must have created that proc before he learned Tcl |
where have you been?
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 |
|
|
sKy
Op
Joined: 14 Apr 2005
Posts: 194
Location: Germany
|
| Posted: Sat May 27, 2006 5:04 pm Post subject: |
|
|
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 |
|
|
demond
Revered One
Joined: 12 Jun 2004
Posts: 3073
Location: San Francisco, CA
|
| Posted: Sat Jun 03, 2006 2:25 am Post subject: |
|
|
| 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 |
|
|
NoZparker
Voice
Joined: 16 Feb 2004
Posts: 34
|
| Posted: Wed Jun 14, 2006 5:21 pm Post subject: Don't Work vs Does Work |
|
|
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 |
|
|
demond
Revered One
Joined: 12 Jun 2004
Posts: 3073
Location: San Francisco, CA
|
| Posted: Thu Jun 15, 2006 1:29 am Post subject: |
|
|
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 |
|
|
NoZparker
Voice
Joined: 16 Feb 2004
Posts: 34
|
| Posted: Thu Jun 15, 2006 1:42 am Post subject: |
|
|
| 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 |
|
|
demond
Revered One
Joined: 12 Jun 2004
Posts: 3073
Location: San Francisco, CA
|
| Posted: Thu Jun 15, 2006 11:23 am Post subject: |
|
|
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 |
|
|
user
Joined: 18 Mar 2003
Posts: 1452
Location: Norway
|
| Posted: Wed Dec 20, 2006 2:52 pm Post subject: interactive event loop in tclsh |
|
|
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
_________________
Have you ever read "The Manual"? |
|
| Back to top |
|
|
user
Joined: 18 Mar 2003
Posts: 1452
Location: Norway
|
| Posted: Fri Dec 29, 2006 8:59 pm Post subject: |
|
|
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
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 |
|
|
user
Joined: 18 Mar 2003
Posts: 1452
Location: Norway
|
| Posted: Tue Jan 02, 2007 2:21 pm Post subject: |
|
|
'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 |
|
|
caesar
Mint Rubber
Joined: 14 Oct 2001
Posts: 3583
Location: Mint Factory
|
| Posted: Tue Jan 02, 2007 4:08 pm Post subject: |
|
|
You never cease to amaze us user. Keep up the good work. Really appreciated.
_________________
I tawt I taw a puddy tat! |
|
| Back to top |
|
|
user
Joined: 18 Mar 2003
Posts: 1452
Location: Norway
|
| Posted: Wed Jan 03, 2007 8:23 am Post subject: |
|
|
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 |
|
|
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
