"Tip of the day"

[user]

Code: Select all

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)

[rosc2112]

Just to clarify, could you post the *final* string2list proc? The thread has gotten a bit confusing to this neophyte =)

[caesar]

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

That's the final one.

[demond]

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:

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

[sKy]

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

Code: Select all

# 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
}

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.

[demond]

Code: Select all

# 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)

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)

[NoZparker]

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

[demond]

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

[NoZparker]

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

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.

[demond]

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?

[user]

Here's some code that may be useful if you want to test event based code in tclsh:

Code: Select all

# 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

[user]

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

Code: Select all

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: Select all

[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

[user]

'stripcodes' for older eggdrops:

Code: Select all

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.

[caesar]

You never cease to amaze us user. Keep up the good work. Really appreciated.

[user]

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: Select all

### 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