namespace ensemble version of tclmr

gistfile1.tcl

#!/usr/bin/env tclsh

package require cmdline
package require struct::set

namespace eval ::tclmr {
  namespace path [list ::cmdline ::struct::set]
  namespace export {[a-z]*}
  namespace ensemble create -unknown tclmr::unknown

  proc register {args} {
    set usage ": register \[options] directory ...\nTag one or more directories with the given tags.\noptions:"
    set opts [getoptions args {
        {tag.arg default {Tags to register}}
        {append          {Append given tags to existing tags}}
      } $usage]
    foreach dir $args {
      set new_tags   [dict get $opts tag]
      set tclmr_file [file join $dir .tclmr]
      if { [dict get $opts append] && [file exists $tclmr_file] } {
        set old_tags [Read $tclmr_file]
        set new_tags [lsort -uniq [concat $new_tags $old_tags]]
      }
      Write $tclmr_file $new_tags
    }
  }

  proc run {args} {
    set usage ": run \[options] command ...\nRun the given command in every directory beneath basepath with the given tag.\noptions:"
    set opts [getoptions args {
        {basepath.arg .  {Directory to begin search for .tclmr files}}
        {tag.arg default {Tags to match against}}
        {dryrun          {Display but don't execute commands}}
      } $usage]
    set command $args
    foreach path [glob [file join [file normalize [dict get $opts basepath]] ** .tclmr]] {
      set tags [Read $path]
      if { [struct::set intersect $tags [dict get $opts tag]] ne {} } {
        set dir [file dirname $path]
        if { [dict get $opts dryrun] != 0 } {
          puts "cd $dir ; $command"
        } else {
          cd $dir
          puts [exec {*}$command]
        }
      }
    }
  }

  proc Read {path} {
    set fh [open $path r]
    set tags [gets $fh]
    close $fh
    return $tags
  }

  proc Write {path tags} {
    set fh [open $path w]
    puts $fh $tags
    close $fh
  }

  proc unknown {cmd subcmd args} {
    puts [format [join {
        {Unknown command: %s}
        {Usage: %s command [options] args}
        {Commands: regsiter, run}
        {See   command -help   for more details.}} "\n"] $subcmd [namespace tail $cmd]]
  }
}

try {
  tclmr {*}$argv
} on error {result options} {
  puts $result
  exit 1
}