lib/gui_script/findfile.tcl

   1 #----- search for specified file
   2
   3 proc 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
  21 proc 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
  48 proc 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 }