AJB which - A utility that almost works like the Unix which, but it works in Windows as well. The difference: if it doesn't find the file, it just returns null. I did this because it makes it easier to work with in programs. Unix returns something like: which: no "filename" in /bin /usr/bin /usr/local/bin ... Also, if anyone has a Mac and knows what delimeter is used in ::env(PATH), could you please post the line to add to the opening switch statement so that this can be truly cross-platform. Thanks.
proc which {filename} {
switch $::tcl_platform(platform) {
windows {set dirlist [split $::env(PATH) \;]}
default {set dirlist [split $::env(PATH) :]}
}
foreach dir $dirlist {
set fullname [file join $dir $filename]
if {[file exists $fullname] && [file executable $fullname]} {
return $fullname
}
}
return ""
}LES: The idea above could also be slightly improved with the ability to detect common extensions in Windows, even if they're not provided in the argument:
proc which {filename} {
switch $::tcl_platform(platform) {
windows { set dirlist [split $::env(PATH) \;] }
default { set dirlist [split $::env(PATH) :] }
}
foreach dir $dirlist {
foreach ext {"" .exe .dll .com .bat} {
set fullname [file join $dir "$filename$ext"]
if { [file exists $fullname] && [file executable $fullname] } {
return $fullname
}
}
}
return ""
}And it could be improved further if the results were sent to a list instead of calling a return at the very sight of the first match. There might be more than one match.
AJB Thanks for the idea, I don't use windows very often and therefore I forgot that you can call binaries without the fullname. This should take care of the list. I did not do this because the "which" in linux doesn't. Also, I wrote this to find binaries, and with other scripts library dependencies, from a running linux system to copy onto a flash drive. Essentially, a script to build a working bootable linux flash chip from a running linux system. Therefore, the list would have made the rest of my programming difficult. I guess I was thinking in terms of a script to use as a building block to create adaptability in other programs.
proc which {filename} {
set list retlist
switch $::tcl_platform(platform) {
windows { set dirlist [split $::env(PATH) \;] }
default { set dirlist [split $::env(PATH) :] }
}
foreach dir $dirlist {
foreach ext {"" .exe .dll .com .bat} {
set fullname [file join $dir "$filename$ext"]
if { [file exists $fullname] && [file executable $fullname] } {
lappend retlist $fullname
}
}
}
if {[info exists retlist]} {return $retlist} {return ""}
}JH tkcon has a more elaborate which that goes beyond executables to also give info on internal Tcl stuff, extracted here:
## which - tells you where a command is found, requires what
# ARGS: cmd - command name
# Returns: where command is found (internal / external / unknown)
##
proc which cmd {
## This tries to auto-load a command if not recognized
set types [uplevel 1 [list what $cmd 1]]
if {[llength $types]} {
set out {}
foreach type $types {
switch -- $type {
alias { set res "$cmd: aliased to [alias $cmd]" }
procedure { set res "$cmd: procedure" }
command { set res "$cmd: internal command" }
executable { lappend out [auto_execok $cmd] }
variable { lappend out "$cmd: $type" }
}
if {[info exists res]} {
global auto_index
if {[info exists auto_index($cmd)]} {
## This tells you where the command MIGHT have come from -
## not true if the command was redefined interactively or
## existed before it had to be auto_loaded. This is just
## provided as a hint at where it MAY have come from
append res " ($auto_index($cmd))"
}
lappend out $res
unset res
}
}
return [join $out \n]
} else {
return -code error "$cmd: command not found"
}
}
## what - tells you what a string is recognized as, used by which
# ARGS: str - string to id
# Returns: id types of command as list
##
proc what {str {autoload 0}} {
set types {}
if {[llength [info commands $str]] || ($autoload && \
[auto_load $str] && [llength [info commands $str]])} {
if {[lsearch -exact [interp aliases] $str] > -1} {
lappend types "alias"
} elseif {
[llength [info procs $str]] ||
([string match *::* $str] &&
[llength [namespace eval [namespace qualifier $str] \
info procs [namespace tail $str]]])
} {
lappend types "procedure"
} else {
lappend types "command"
}
}
if {[llength [uplevel 1 info vars $str]]} {
upvar 1 $str var
if {[array exists var]} {
lappend types array variable
} else {
lappend types scalar variable
}
}
if {[file isdirectory $str]} {
lappend types "directory"
}
if {[file isfile $str]} {
lappend types "file"
}
if {[llength [info commands winfo]] && [winfo exists $str]} {
lappend types "widget"
}
if {[string compare {} [auto_execok $str]]} {
lappend types "executable"
}
return $types
}