glob.tcl

   1 # (c) 2008 Steve Bennett <steveb@workware.net.au>
   2 #
   3 # Implements a Tcl-compatible glob command based on readdir
   4 #
   5 # This file is licenced under the FreeBSD license
   6 # See LICENCE in this directory for full details.
   7
   8
   9 # Implements the Tcl glob command
  10 #
  11 # Usage: glob ?-nocomplain? pattern ...
  12 #
  13 # Patterns use 'string match' (glob) pattern matching for each
  14 # directory level, plus support for braced alternations.
  15 #
  16 # e.g. glob "te[a-e]*/*.{c,tcl}"
  17 #
  18 # Note: files starting with . will only be returned if matching component
  19 #       of the pattern starts with .
  20 proc glob {args} {
  21
  22         # If $dir is a directory, return a list of all entries
  23         # it contains which match $pattern
  24         #
  25         local proc glob.readdir_pattern {dir pattern} {
  26                 set result {}
  27
  28                 # readdir doesn't return . or .., so simulate it here
  29                 if {$pattern in {. ..}} {
  30                         return $pattern
  31                 }
  32
  33                 # Use -nocomplain here to return nothing if $dir is not a directory
  34                 foreach name [readdir -nocomplain $dir] {
  35                         if {[string match $pattern $name]} {
  36                                 # Only include entries starting with . if the pattern starts with .
  37                                 if {[string index $name 0] eq "." && [string index $pattern 0] ne "."} {
  38                                         continue
  39                                 }
  40                                 lappend result $name
  41                         }
  42                 }
  43
  44                 return $result
  45         }
  46
  47         # glob entries in directory $dir and pattern $rem
  48         #
  49         local proc glob.do {dir rem} {
  50                 # Take one level from rem
  51                 # Avoid regexp here
  52                 set i [string first / $rem]
  53                 if {$i < 0} {
  54                         set pattern $rem
  55                         set rempattern ""
  56                 } else {
  57                         set pattern [string range $rem 0 $i-1]
  58                         set rempattern [string range $rem $i+1 end]
  59                 }
  60
  61                 # Determine the appropriate separator and globbing dir
  62                 set sep /
  63                 set globdir $dir
  64                 if {[string match "*/" $dir]} {
  65                         set sep ""
  66                 } elseif {$dir eq ""} {
  67                         set globdir .
  68                         set sep ""
  69                 }
  70
  71                 set result {}
  72
  73                 # If the pattern contains a braced expression, recursively call glob.do
  74                 # to expand the alternations. Avoid regexp for dependency reasons.
  75                 # XXX: Doesn't handle backslashed braces
  76                 if {[set fb [string first "\{" $pattern]] >= 0} {
  77                         if {[set nb [string first "\}" $pattern $fb]] >= 0} {
  78                                 set before [string range $pattern 0 $fb-1]
  79                                 set braced [string range $pattern $fb+1 $nb-1]
  80                                 set after [string range $pattern $nb+1 end]
  81
  82                                 foreach part [split $braced ,] {
  83                                         lappend result {*}[glob.do $dir $before$part$after]
  84                                 }
  85                                 return $result
  86                         }
  87                 }
  88
  89                 # Use readdir and select all files which match the pattern
  90                 foreach f [glob.readdir_pattern $globdir $pattern] {
  91                         if {$rempattern eq ""} {
  92                                 # This is a terminal entry, so add it
  93                                 lappend result $dir$sep$f
  94                         } else {
  95                                 # Expany any entries at this level and add them
  96                                 lappend result {*}[glob.do $dir$sep$f $rempattern]
  97                         }
  98                 }
  99                 return $result
 100         }
 101
 102         # Start of main glob
 103         set nocomplain 0
 104
 105         if {[lindex $args 0] eq "-nocomplain"} {
 106                 set nocomplain 1
 107                 set args [lrange $args 1 end]
 108         }
 109
 110         set result {}
 111         foreach pattern $args {
 112                 if {$pattern eq "/"} {
 113                         lappend result /
 114                 } elseif {[string match "/*" $pattern]} {
 115                         lappend result {*}[glob.do / [string range $pattern 1 end]]
 116                 } else {
 117                         lappend result {*}[glob.do "" $pattern]
 118                 }
 119         }
 120
 121         if {$nocomplain == 0 && [llength $result] == 0} {
 122                 return -code error "no files matched glob patterns"
 123         }
 124
 125         return $result
 126 }