1#----- search for specified file
2
3proc findfile:check {type fname} {
4  global tcl_platform
5  if {$type == "executable" && $tcl_platform(platform) == "windows"} {
6    foreach ext {.com .exe .bat} {
7      if [file exists $fname$ext] {
8        return $fname$ext
9      }
10    }
11  }
12  if [file $type $fname] {
13    if {$type == "executable" && [file isdirectory $fname]} {
14        return {}
15    }
16    return $fname
17  }
18  return {}
19}
20
21proc findfile:path {str delim} {
22  global env
23  set path {}
24  foreach p [split $str $delim] {
25    set dir {}
26    foreach d [split $p /] {
27      if {[string length $d] > 1 && [string index $d 0] == {$}} {
28        if [info exists env([string range $d 1 end])] {
29          lappend dir $env([string range $d 1 end])
30        } else {
31          set dir {}
32          break
33        }
34      } else {
35        lappend dir $d
36      }
37    }
38    if [llength $dir] {
39      lappend path [join $dir /]
40    }
41  }
42  if [llength $path] {
43    return [join $path $delim]
44  }
45  return ""
46}
47
48proc find_file {type fname args} {
49  global tcl_platform env
50
51  if {$fname == ""} {
52    return {}
53  }
54  set dr [file dirname $fname]
55  set fn [file tail $fname]
56  if {$type == ""} {
57    set type exists
58  }
59
60  # check if path given
61
62  if {$dr != "."} {
63    set curdir [pwd]
64    catch {cd $dr}
65    set filename [pwd]/$fn
66    cd $curdir
67    return [findfile:check $type $filename]
68  }
69
70  # check if running under windows
71
72  if {[info exists tcl_platform(platform)] &&
73    $tcl_platform(platform) == "windows"} {
74    set delim ";"
75  } else {
76    set delim ":"
77  }
78
79  if {$args == ""} {
80
81    # check current directory
82
83    set filename [findfile:check $type [pwd]/$fn]
84    if {$filename != ""} {
85      return $filename
86    }
87    if {$fname != $fn} {
88      return {}
89    }
90
91    # check PATH environment variable
92
93    if [info exists env(PATH)] {
94      foreach dir [split $env(PATH) $delim] {
95        set filename [findfile:check $type $dir/$fn]
96        if {$filename != ""} {
97          return $filename
98        }
99      }
100    }
101
102  } else {
103
104    # check supplied list of paths/directories
105
106    foreach val $args {
107      foreach ent [split $val] {
108        if {$ent != ""} {
109          set path [findfile:path $ent $delim]
110          if {$path != ""} {
111            foreach dir [split $path $delim] {
112              set filename [findfile:check $type $dir/$fn]
113              if {$filename != ""} {
114                return $filename
115              }
116            }
117          }
118        }
119      }
120    }
121  }
122
123  return {}
124}
125