bind pub - "!find" pub:cari
proc pub:cari { nick host hand chan text } {
set judul [lindex $text 0]
if { $judul == ""} {
puthelp "notice $nick :ketik !find <penyanyi/artis>"
return
} else {
putquick "notice $nick :being processed $judul"
catch [list exec find /home/gusman/mp3 -name "*$judul*" -type f -printf "%f\n"] data
putserv "notice $nick :!putar $data"
putserv "notice $nick :copy paste di channel !putar $data"
}
}
putlog "find.tcl"
if sought is in the data
it works well to post to the target.
if the searched in data is empty, it does not work, please indicate whether this scripts is incomplete or wrong.
I've got the solution on this line:
if { $judul == ""}
Does something like this work?
proc pub:cari { args } {
lassign $args nick host hand chan text
...
Normally in TCL if you don't pass enough arguments to a function then you'll get an error. If you don't know how many arguments your function will take, you can name the last argument "args", and any extra arguments will be put in this variable as a list.
Related
I have a variable, let's say xx, with a list of index 0 and index 1 values. I want to modify a script (not mine) which previously defines a function, pptable, i.e.,
proc pptable {l1 l2} {
foreach i1 $l1 i2 $l2 {
puts " [format %6.2f $i1]\t[format %6.2f $i2]"
}
}
so that it displays the output into two columns using
pptable [lindex $xx 1] [lindex $xx 0]
However, I want to write the output directly to a file. Could you tell me how I can send the data to a file instead to the display?
One of the neatest ways of doing this is to stack on a channel transform that redirects stdout to where you want it to go. This works even if the write to stdout happens from C code or in a different thread as it plugs into the channel machinery. The code is a little bit long (and requires Tcl 8.6) but is reliable and actually mostly very simple.
package require Tcl 8.6; # *REQUIRED* for [chan push] and [chan pop]
proc RedirectorCallback {targetHandle op args} {
# The switch/lassign pattern is simplest way of doing this in one procedure
switch $op {
initialize {
lassign $args handle mode
# Sanity check
if {$mode ne "write"} {
close $targetHandle
error "this is just a write transform"
}
# List of supported subcommands
return {initialize finalize write}
}
finalize {
lassign $args handle
# All we need to do here is close the target file handle
close $targetHandle
}
write {
lassign $args handle buffer
# Write the data to *real* destination; this does the redirect
puts -nonewline $targetHandle $buffer
# Stop the data going to *true* stdout by returning empty string
return ""
# If we returned the data instead, this would do a 'tee'
}
default {
error "unsupported subcommand"
}
}
}
# Here's a wrapper to make the transform easy to use
proc redirectStdout {file script} {
# Stack the transform onto stdout with the file handle to write to
# (which is going to be $targetHandle in [redirector])
chan push stdout [list RedirectorCallback [open $file "wb"]]
# Run the script and *definitely* pop the transform after it finishes
try {
uplevel 1 $script
} finally {
chan pop stdout
}
}
How would we actually use this? It's really very easy in practice:
# Exactly the code you started with
proc pptable {l1 l2} {
foreach i1 $l1 i2 $l2 {
puts " [format %6.2f $i1]\t[format %6.2f $i2]"
}
}
# Demonstrate that stdout is working as normal
puts "before"
# Our wrapped call that we're capturing the output from; pick your own filename!
redirectStdout "foo.txt" {
pptable {1.2 1.3 1.4} {6.9 6.8 6.7}
}
# Demonstrate that stdout is working as normal again
puts "after"
When I run that code, I get this:
bash$ tclsh8.6 stdout-redirect-example.tcl
before
after
bash$ cat foo.txt
1.20 6.90
1.30 6.80
1.40 6.70
I believe that's precisely what you are looking for.
You can do this with less code if you use Tcllib and TclOO to help deal with the machinery:
package require Tcl 8.6
package require tcl::transform::core
oo::class create WriteRedirector {
superclass tcl::transform::core
variable targetHandle
constructor {targetFile} {
set targetHandle [open $targetFile "wb"]
}
destructor {
close $targetHandle
}
method write {handle buffer} {
puts -nonewline $targetHandle $buffer
return ""
}
# This is the wrapper, as a class method
self method redirectDuring {channel targetFile script} {
chan push $channel [my new $targetFile]
try {
uplevel 1 $script
} finally {
chan pop $channel
}
}
}
Usage example:
proc pptable {l1 l2} {
foreach i1 $l1 i2 $l2 {
puts " [format %6.2f $i1]\t[format %6.2f $i2]"
}
}
puts "before"
WriteRedirector redirectDuring stdout "foo.txt" {
pptable {1.2 1.3 1.4 1.5} {6.9 6.8 6.7 6.6}
}
puts "after"
I assume you don't want or can't modify the existing script and proc pptable, correct?
If so, there are different options, depending on your exact situation:
Redirect stdout: tclsh yourscript.tcl > your.out
Redefine puts (for a clearly defined scope):
rename ::puts ::puts.orig
proc puts args {
set fh [open your.out w];
::puts.orig $fh $args;
close $fh
}
# run pptable, source the script
This theme has been covered before, e.g., tcl stop all output going to stdout channel?
Rewire Tcl's stdout channel (not necessarily recommended):
close stdout
open your.out w
# run pptable, source the script
This has also been elaborated on before, e.g. Tracing stdout and stderr in Tcl
There is a TCL script which has multiple procedure definitions with similar name func in different namespaces. Procedures look like this:
proc func {a} {
puts $a
}
All that kind of procedures have only one argument a . All that kind of procedures are called from one single line in whole script:
func $a
I need to create another procedure definition also with similar name func in other namespace. But that procedure will have two parameters. That procedure is also need to be called from the same line that other procedures with same name. Procedure looks like this:
proc func {a b} {
puts $a
puts $b
}
I need now to modify the line that calls all that procedures func $a so, that it can call all procedures with one parameter and new procedure which has two parameters. But procedures definitions with one parameter must not be changed. What line that calls all these procedures func $a should look like?
If you want an optional parameter, and you know what the optional value should be if not supplied, you do this:
proc func {a {b "the default"}} {
puts "a is $a"
puts "b is $b"
}
If you need to compute the default value at runtime, the simplest technique is a magic sentinel value that is very unlikely to occur in real input. Such as two ASCII NUL characters (== Unicode U+000000):
proc func {a {b "\u0000\u0000"}} {
if {$b eq "\u0000\u0000"} {
set b "default:$a"
}
puts "a is $a"
puts "b is $b"
}
Otherwise, you can use the magic args value to get the complete list of arguments and do all the work “by hand”:
proc func {a args} {
if {[llength $args] == 0} {
set b "the default..."
} elseif {[llength $args] == 1} {
set b [lindex $args 0]
} else {
error "bad number of arguments!"
}
puts "a is $a"
puts "b is $b"
}
If you're doing that, the info level introspector can help, but things can get complicated…
To call one of two implementations of a command depending on the number of arguments is rather unusual in Tcl code. You can do it providing neither implementation of the command is in the global namespace and you are not wanting the switching behaviour when calling from the namespaces containing the implementations in question.
What you do is you create a procedure in the global namespace (which every other namespace will look for commands in if not present locally) which then chains explicitly to the desired implementation. The main thing you need to enable this is some way of working out which implementation you want in a particular case (such as looking at the length of the argument list).
For Tcl 8.6, you can use tailcall for the chaining for maximum efficiency:
proc ::func args {
if {[llength $args] == 1} {
tailcall ::impl1::func {*}$args
} else {
tailcall ::impl2::func {*}$args
}
}
In Tcl 8.5 you'd write this instead (which is an optimised case in the interpreter):
proc ::func args {
if {[llength $args] == 1} {
return [uplevel 1 [list ::impl1::func {*}$args]]
} else {
return [uplevel 1 [list ::impl2::func {*}$args]]
}
}
In older Tcl versions, you'd use something like this (which is slower):
proc ::func args {
if {[llength $args] == 1} {
return [uplevel 1 ::impl1::func $args]
} else {
return [uplevel 1 ::impl2::func $args]
}
}
None of this is perfect at handling getting the right sort of error messages when you call with entirely the wrong number of arguments, especially if neither implementation formally has optional arguments. Determining that automatically is probably wholly impractical! You end up having to write extra boilerplate code (which is pretty obvious and works in all versions of Tcl in a straight-forward way):
proc ::func args {
if {[llength $args] == 1} {
tailcall ::impl1::func {*}$args
} elseif {[llength $args] == 2} {
tailcall ::impl2::func {*}$args
} else {
# Using the -errorcode is optional really
return -code error -errorcode {TCL WRONGARGS} \
"wrong # args: should be \"func a ?b?\""
}
}
I found the solution from that answer: https://stackoverflow.com/a/22933188/1601703 . We can get the number of argument that procedure accepts and make coresponding if statments that will use corresponding procedure call:
set num [llength [info args func]]
if {$num == 1} {
func $a
} elseif {$num == 2} {
func $a $b
}
I just started to learn Tcl. I wanted to write a simple procedure.
When the procedure starts, it opens a browse window to browse for files.
There you can select a file you want to open.
Then a pop-up windows comes up and asks if you want to selected another file.
Every file that you select has to go into an array.
I have to following code:
########## Defining the sub procedures ############
proc open_file {} {
set n 0
set title "Select a file"
set types {
{{GDS files} {.gds} }
{{All Files} * }
}
set filename [tk_getOpenFile -filetypes $types -title $title]
set opendFiles($n) $filename
set n [expr $n + 1]
set answer [tk_messageBox -message "Load another GDS file?" -type yesno -icon question]
if {$answer == yes } {
open_file
} else {
show_files ($opendFiles)
}
}
proc show_files {} {
foreach key [array names opendFiles] {
puts $opendFiles($key)
}
}
########## Main Program ###########
open_file
I having the following problems. Because I always recall the proc 'open_file' the variable $n keeps setting to 0. But I don't know how to recall the opening of the window without recalling the whole subroutine....
The second problem is sending the array to the next proc. When I send to the to the proc 'show_files', I always get the next error : can't read "opendFiles": variable is array.
I can't seem to find both answers..
You need global variables for that. This works for me:
########## Defining the sub procedures ############
set n 0
array set openedFiles {}
proc open_file {} {
set title "Select a file"
set types {
{{GDS files} {.gds} }
{{All Files} * }
}
set filename [tk_getOpenFile -filetypes $types -title $title]
set ::openedFiles($::n) $filename
incr ::n
set answer [tk_messageBox -message "Load another GDS file?" -type yesno -icon question]
if {$answer == yes } {
open_file
} else {
show_files
}
}
proc show_files {} {
foreach key [array names ::openedFiles] {
puts $::openedFiles($key)
}
}
########## Main Program ###########
open_file
Array Problem
In Tcl you can't send arrays to procs. You need to convert them to a list with array get send this list to the proc and than convert it back to an array again with array set.
Global variables are very useful at times, but I believe they are best avoided where possible. In this case I'd rather process the loop and the array in the main program rather than the proc.
Also, where you'd use an array in other programming languages, it's often better to use a list in Tcl, so something like:
proc open_file {} {
set title "Select a file"
set types {
{{GDS files} {.gds} }
{{All Files} * }
}
set filename [tk_getOpenFile -filetypes $types -title $title]
return $filename
}
proc show_files {files} {
foreach file $files {
puts $file
}
}
set openedFiles [list]
set answer yes
while {$answer == yes}
lappend openedFiles [open_file]
set answer [tk_messageBox -message "Load another GDS file?" -type yesno -icon question]
}
show_files $openedFiles
If you're into brevity, show_files could be written
proc show_files {files} {
puts [join $files \n]
}
and, now that it's so short, you could just put it in line, rather than have another proc.
Finally, have you considered what you want to do if the user presses cancel in tk_getOpenFile? In this case filename will be set to an empty (zero-length) string. You could either
ignore these; or
get rid of the tk_messageBox call and have the user press cancel when they have entered as many files as they want.
If you want to just ignore those times when the user pressed cancel, you could do
set filename [open_file]
if {[string length $filename] > 0} {
# The user entered a new filesname - add it to the list
lappend openedFiles $filesname
} else {
# The user pressed cancel - just ignore the filename
}
If you wanted to use cancel to break out of the loop, then the main program becomes something like:
set openedFiles [list]
set filename dummy
while {[string length $filename] > 0} {
set filename [open_file]
if {[string length $filename] > 0} {
lappend openedFiles $filename
}
}
show_files $openedFiles
in this case, you might want to put up a message box right at the start of the main program telling the user what's going on.
For the state of a variable to persist between calls to a procedure, you need to make that variable live outside the procedure. The easiest way is to use a global variable:
# Initialize it...
set n 0
proc open_file {} {
# Import it...
global n
...
# Use it...
set openedFiles($n) $filename
incr n
...
}
Arrays are not values, and as such can't be passed directly to another procedure. You can handle this by passing in the name and using upvar 1 to link a local alias to the variable in the calling stack frame:
proc show_files {varName} {
upvar 1 $varName ary
foreach key [array names ary] {
puts $ary($key)
}
}
Which is called using the name of the array, so no $:
show_files openedFiles
(You could also pass a serialization of the array in with array get openedFiles to serialize and array set ary $serialization to deserialize, but that carries some overhead.)
You probably ought to add that openedFiles variable to the global line, so that it is persistent across all invokations of open_file.
I'm relatively new in TCL, in TCL prompt, when we invoke a proc with some return value, the proc's return value is echoed back by tcl. Is there a way to stop it (without affecting puts or similar functionality) as an example
bash$ tclsh
% proc a {} { puts "hello"; return 34; }
% a
hello
34
%
Now how do i suppress the 34 coming to the screen? Any help is appreciated.
Update:
Actually the proc is a part of another tool, earlier it did not have any return value, but now conditionally it can return a value.
it can be called from a script and there won't be any problem (as Bryan pointed out). and it can be called from interactive prompt, then after all the necessary outputs, the return value is getting printed unnecessarily.
So 1) I don't have the facility of changing a user's tclshrc 2) existing scripts should continue to work.
And it seems strange that every time the proc is called, after all the necessary outputs, a number gets printed. To a user, this is a needless information unless he has caught the value and wants to do something. So i wanted the value to be delivered to user, but without getting printed to prompt/UI (hope i'm clear )
The interactive shell code in tclsh and wish will print any non-empty result. To get nothing printed, you have to have the last command on the “line” produce an empty result. But which command to use?
Many commands will produce an empty result:
if 1 {}
subst ""
format ""
However, the shortest is probably:
list
Thus, you could write your code like:
a;list
Of course, this only really becomes useful when your command actually produces a large result that you don't want to see. In those cases, I often find that it is most useful to use something that measures the size of the result, such as:
set tmp [something_which_produces a_gigantic result]; string length $tmp
The most useful commands I find for that are string length, llength and dict size.
If you absolutely must not print the result of the command, you have to write your own interactive loop. There are two ways to do this, depending on whether you are running inside the event loop or not:
Without the event loop
This simplistic version just checks to see if the command name is in what the user typed. It's probably not a good idea to arbitrarily throw away results otherwise!
set accum ""
while {[gets stdin line] >= 0} {
append accum $line "\n"
if {[info complete $accum]} {
if {[catch $accum msg]} {
puts stderr $msg
} elseif {$msg ne "" && ![string match *TheSpecialCommand* $accum]} {
puts $msg
}
set accum ""
}
}
With the event loop
This is just handling the blocking IO case; that's the correct thing when input is from a cooked terminal (i.e., the default)
fileevent stdin readable handleInput
set accum ""
proc handleInput {} {
global accum
if {[gets stdin line] < 0} {
exit; # Or whatever
}
append accum $line "\n"
if {[info complete $accum]} {
if {[catch {uplevel "#0" $accum} msg]} {
puts stderr $msg
} elseif {$msg ne "" && ![string match *TheSpecialCommand* $accum]} {
puts $msg
}
set accum ""
}
}
vwait forever; # Assuming you're not in wish or have some other event loop...
How to detect the command is being executed
The code above uses ![string match *TheSpecialCommand* $accum] to decide whether to throw away the command results, but this is very ugly. A more elegant approach that leverages Tcl's own built-in hooks is to use an execution trace to detect whether the command has been called (I'll just show the non-event-loop version here, for brevity). The other advantage of this is that it is simple to extend to suppressing the output from multiple commands: just add the trace to each of them.
trace add execution TheSpecialCommand enter SuppressOutput
proc SuppressOutput args {
# Important; do not suppress when it is called inside another command
if {[info level] == 1} {
set ::SuppressTheOutput 1
}
}
# Mostly very similar from here on
set accum ""
while {[gets stdin line] >= 0} {
append accum $line "\n"
if {[info complete $accum]} {
set SuppressTheOutput 0; # <<<<<< Note this!
if {[catch $accum msg]} {
puts stderr $msg
} elseif {$msg ne "" && !$SuppressTheOutput} { # <<<<<< Note this!
puts $msg
}
set accum ""
}
}
To be clear, I wouldn't ever do this in my own code! I'd just suppress the output manually if it mattered.
You could make an empty procedure in .tclshrc...
proc void {} {}
...and when you don't need a return value, end the line with ;void.
Use tcl_interactive variable to enable the return of of the value, although I'm not sure where this would be useful...
proc a {} {
puts "hello"
if { [info exist tcl_interactive] } {
return {};
} else {
return 34;
}
}
I am writing a proc to create a header in an output file.
Currently it needs to take an optional parameter, which is a possible comment for the header.
I have ended up coding this as a single optional parameter
proc dump_header { test description {comment = ""}}
but would like to know how I can achieve the same using args
proc dump_header { test description args }
It's quite easy to check for args being a single blank parameter ($args == ""), but doesn't cope well if passing multiple parameters - and I need the negative check anyway.
Your proc definition is incorrect (you'd get the error message too many fields in argument specifier "comment = """). Should be:
proc dump_header { test description {comment ""}} {
puts $comment
}
If you want to use args, you could examine the llength of it:
proc dump_header {test desc args} {
switch -exact [llength $args] {
0 {puts "no comment"}
1 {puts "the comment is: $args"}
default {
puts "the comment is: [lindex $args 0]"
puts "the other args are: [lrange $args 1 end]"
}
}
}
You might also want to pass name-value pairs in a list:
proc dump_header {test desc options} {
# following will error if $options is an odd-length list
array set opts $options
if {[info exists opts(comment)]} {
puts "the comment is: $opts(comment)"
}
puts "here are all the options given:"
parray opts
}
dump_header "test" "description" {comment "a comment" arg1 foo arg2 bar}
Some prefer a combination of args and name-value pairs (a la Tk)
proc dump_header {test desc args} {
# following will error if $args is an odd-length list
array set opts $args
if {[info exists opts(-comment)]} {
puts "the comment is: $opts(-comment)"
}
parray opts
}
dump_header "test" "description" -comment "a comment" -arg1 foo -arg2 bar
I use tcllib's cmdline library to do option parsing.
This is the example from cmdline documentation:
set options {
{a "set the atime only"}
{m "set the mtime only"}
{c "do not create non-existent files"}
{r.arg "" "use time from ref_file"}
{t.arg -1 "use specified time"}
}
set usage ": MyCommandName \[options] filename ...\noptions:"
array set params [::cmdline::getoptions argv $options $usage]
if { $params(a) } { set set_atime "true" }
set has_t [expr {$params(t) != -1}]
set has_r [expr {[string length $params(r)] > 0}]
if {$has_t && $has_r} {
return -code error "Cannot specify both -r and -t"
} elseif {$has_t} {
...
}
So, in your case, you'd just use args in place of argv in the above example.
It should be mentioned explicitly that args is a special word in Tcl that, when used at the end of the argument list, contains a list of all the remaining arguments. If no args are given, then no error is produced (unlike any other variable name, which would be considered a required argument).
I was looking for a way to have functionality similar to python's kwargs (optional key-value pair arguments), and something that works nicely is (similar to Glenn's last example):
proc my_proc {positional_required1 {positional_optional1 "a_string"} args} {
# Two optional arguments can be given: "opt1" and "opt2"
if {![string equal $args ""]} {
# If one or more args is given, parse them or assign defaults.
array set opts $args
if {[info exists opts(opt1)]} { set opt1 $opts(opt1) } else { set opt1 0 }
if {[info exists opts(op2)]} { set opt2 $opts(opt2) } else { set opt2 -1 }
} else {
# If no args are given, assign default values.
set op1 0
set op2 -1
}
# DO STUFF HERE
}
And can be called like:
my_proc "positional_required1_argument"
# OR
my_proc "positional_required1_argument" "a_string"
# OR
my_proc "positional_required1_argument" "a_string" opt1 7
# OR
my_proc "positional_required1_argument" "a_string" opt1 7 opt2 50
# etc.
A potential downside (as I've currently implemented it) is that if a user passes a non-approved key-value option, there is no error.