I know this isn't the most efficient code, but it is the first tclapp i have managed to finish, and it seems to work great. Any suggestions would be appreciated.



   #mime.tcl
   #usage:
   # mime.tcl ?-tk? ?-outdir dirname? ?-indir dirname? ?-delay int? ?filename? ?filename...?
   #set to a different value if you want it to default to saving to a different directory
   #make sure the direcory exists before executing the script
   set outdir [file normalize [file join [file dirname [info script]] extracted]]
   #other global vars
   set debug 0   ;#output extra info
   set tkLoaded 0  ;#don't automatically load tk, so this var will be set to 1 if tk is loaded
   set indir {}   ;#list to stor input directories
   set files {}   ;#list to store file names
   set delay 200   ;#proc that may take a long time to execute will use this to prevent locking up completely, set to 0 for no delay
   set version "0.1"
   set title "Mime File Attachment Extractor $version"
   proc main {argc argv} {
      global tkLoaded outdir indir files delay debug title
      #load tk if it is on the command line
      if {[lsearch -exact $argv -tk] > -1} {
         if {[catch {package require Tk}] || $tkLoaded} {
            textOut "Tk could not be loaded, continuing without Tk"
            set tkLoaded 0
         }
      }
      #see if tk is loaded
      set tkLoaded [pkgLoaded Tk]
      #create main window, if tk is loaded
      createWin
      #about stuff
      textOut $title
      textOut "Extracts attachments from .eml files\n"
      #load mime package if available
      if {[catch {package require mime}]} {
         textOut "\"mime\" package could not be loaded.\nPlease get \"tcllib\" from http://tcl.tk/"
         if {!$tkLoaded} {exit 1} else {return}
      }
      #load base64 package if available
      if {[catch {package require base64}]} {
         textOut "\"base64\" package could not be loaded.\nPlease get \"tcllib\" from http://tcl.tk/"
         if {!$tkLoaded} {exit 1} else {return}
      }
      if {$debug} {
         textOut "args: $argv"
         textOut "script: [file normalize [info script]]"
      }
      #parse command line
      for {set i 0} {$i<[llength $argv]} {incr i} {
         switch -- [string tolower [lindex $argv $i]] {
            -tk {
               ;#already handled so textOut will work in this proc
            }
            -outdir { 
               #output directory, can only have 1, last -outdir on command line has priority
               #this proc does not create the directory
               incr i
               if {[file isdirectory [file normalize [lindex $argv $i]]]} {
                  set outdir [file normalize [lindex $argv $i]]
               } else {
                  textOut "[file normalize [lindex $argv $i]] does not exist! Using default outdir!"
               }
            }
            -indir {
               #list of input directories, can list more than 1 on the command line
               incr i
               lappend indir [file normalize [lindex $argv $i]]
            }
            -delay {
               #delay for procs that may lock up tk, ignored if not using tk
               incr i
               if {[string is int [lindex $argv $i]]} {set delay [lindex $argv $i]}
            }
            default {
               lappend files [file normalize [lindex $argv $i]]
            }
         }
      }
      #extra info
      if {$debug} {
         textOut "outdir: $outdir"
         textOut "indir: $indir"
         textOut "files: $files"
         textOut "delay: $delay"
      }
      #search input directories
      searchInput
      #exit with error code 0, if tk is not loaded
      if {!$tkLoaded} {exit 0}
   }
   proc searchInput {{index 0}} {
      global indir files delay tkLoaded
      if {$index < [llength $indir]} {
         set dir [lindex $indir $index]
         if {[string length $dir] && [file isdirectory $dir]} {
            textOut "Searching \"$dir\""
            foreach f [glob -nocomplain -directory $dir -types {d f} *] {
               if {[file isdirectory $f] && [lsearch -exact $indir $f] < 0} {
                  lappend indir $f
               } elseif {[file isfile $f] && [lsearch -exact $files $f] < 0} {
                  lappend files $f
               }
            }
         }
         incr index
         if {$tkLoaded && $delay} {
            after $delay "searchInput $index"
         } else {
            searchInput $index
         }
      } else {
         #we are done searching for files, start processing files
         mimeExtract
      }
   }
   proc mimeExtract {{index 0}} {
      global files delay tkLoaded outdir debug
      if {$index < [llength $files]} {
         set cFile [lindex $files $index]
         textOut "\nFile: $cFile"
         #open the file with mime
         if {![catch {set token [mime::initialize -file $cFile]}]} {
            if {$debug} {
               foreach {p v} [mime::getproperty $token] {textOut "\t$p : $v"}
            }
            foreach p [mimeGetParts $token] {
               mimeSaveFile $p
            }
            #close the file
            mime::finalize $token
         } else {
            textOut "\tFile is not a Mime file."
         }
         incr index
         if {$tkLoaded && $delay} {
            after $delay "mimeExtract $index"
         } else {
            mimeExtract $index
         }
      }
   }
   proc mimeGetParts {token} {
      set parts {}
      if {![catch {mime::getproperty $token parts}]} {
         foreach p [mime::getproperty $token parts] {
            lappend parts $p
            foreach p1 [mimeGetParts $p] {
               lappend parts $p1
            }
         }
      }
      return $parts
   }
   proc mimeGetPartName {token} {
      set params [mime::getproperty $token params]
      set i [lsearch -exact $params name]
      if {$i >= 0} {
         incr i
         return [lindex $params $i]
      }
      return
   }
   proc mimeSaveFile {token} {
      global outdir
      set name [mimeGetPartName $token]
      #if it dos not have a name, return
      if {![string length $name]} {return}
      #filename
      set file [file normalize [file join $outdir $name]]
      #make unique filename
      #break up file name
      set fn [join [lrange [split $name .] 0 end-1] .]
      if {[split $name .] > 1} {
         set ext [lindex [split $name .] end]
      } else {set ext txt}
      for {set i 0} {[file exists $file]} {incr i} {
         set file [file join $outdir $fn.$i.$ext]
      }
      textOut "\t$token > $name > $file"
      #save attachment
      set f [open $file w+]
      mime::copymessage $token $f
      close $f
      #decode attachment
      decode $file
   }
   proc decode {file} {
      if {![catch {set f [open $file r]}]} {
         set l {}
         set decode 0
         set encoding text
         set data {}
         while {![eof $f]} {
            gets $f l
            set l [string trim $l]
            if {!$decode} {
               if {![string length $l]} {
                  if {$encoding == "text"} { break }
                  set decode 1
               } elseif {[lindex $l 0] == "Content-Transfer-Encoding:"} {
                  set encoding [lindex $l 1]
               }
               
            } else {
               set data [set data]$l
            }
         }
         seek $f 0 start
         close $f
         if {$decode && $encoding == "base64"} {
            set f [open $file w+]
            fconfigure $f -translation binary
            set data [base64::decode $data]
            puts -nonewline $f $data
            close $f
         }
      }
   }
   proc textOut {text} {
      global tkLoaded
      if {$tkLoaded} {
         .t configure -state normal
         .t insert end "$text\n"
         .t see end
         .t configure -state disabled
      } else {puts $text}
   }
   proc createWin {} {
      global tkLoaded title
      if {$tkLoaded} {
         #use autoscroll if it is available
         if {![catch {package require autoscroll}]} {::autoscroll::wrap}
         #create and display text with scrollbars
         text .t -state disabled -xscrollcommand ".x set" \
            -yscrollcommand ".y set" -font "Courier 10" -wrap none
         scrollbar .x -orient h -command ".t xview"
         scrollbar .y -orient v -command ".t yview"
         grid .t -row 0 -column 0 -sticky news
         grid .x -row 1 -column 0 -sticky news
         grid .y -row 0 -column 1 -sticky news
         grid rowconfigure . 0 -weight 1
         grid columnconfigure . 0 -weight 1
         wm title . $title
      }
   }
   proc pkgLoaded {pkg} {return [expr ![catch {package present $pkg}]]}
   main $argc $argv