Posted to tcl by aspect at Thu Feb 02 22:07:12 GMT 2017view pretty
# main as an ensemble is sweet variable START set START [clock seconds] # ----- private commands: set fossil_dir $env(HOME)/.fossils ;# keep all our fossils in one place set fossil_bin fossil ;# rely on $PATH proc Find {name} { variable fossil_dir file join $fossil_dir $name } proc Fossil {args} { ;# use this for the shell command variable fossil_bin # FIXME: quote args a la lexec? Exec $fossil_bin {*}$args } # some silly helpers: # FIXME: need a better [exec]-like pattern for this stuff proc F:current-branch {} { variable fossil_bin exec $fossil_bin branch | awk {/^*/ {print $2}} } proc F:parent {hash} { variable fossil_bin exec $fossil_bin info $hash | awk {/^parent:/ {print $2}} } # ----- utilities: # Make errors and logging easier proc Error {args} { tailcall return -code error $args } proc Log {args} { puts stderr "[TS] $args" } proc TS {} { variable START set elapsed [expr {[clock seconds] - $START}] set secs [expr {$elapsed / 1000}] set ms [expr {$elapsed % 1000}] format %s:%.03d [ clock format $secs -format %M:%S ] $ms } # Namespace unknowns are weird. proc Unknown {_ cmd args} { list [namespace which Fossil] $cmd } # A more shell-script like [exec]. Passes stdout/err through, # and returns the exit code. proc Exec {args} { # FIXME: handle redirections. Use >$ 2>$ for variables set rc [catch { exec {*}$args >@ stdout 2>@ stderr } e o] if {$rc == 0} { return $rc } else { return [lindex [dict get $o -errorcode] 2] } } # create directory/ies, unless they already exist # BEWARE: race-prone. Tcl's [file mkdir] is already race-prone # so this can't be fixed in Tcl. Just be careful. proc Mkdir {args} { foreach dir $args { if {[file exists $dir]} { if {[file isdirectory]} { Error "Directory already exists" $dir } else { Error "File exists" $dir } } } file mkdir {*}$args } # ----- aliases and wrappers for fossil commands proc clone {url} { foreach name [lreverse [split $url /]] { ;# FIXME: support same repo name from multiple sources .. aliases? if {$name ne ""} break } if {$name eq "" || [string match *: $name]} { Error "Unable to derive name for $url: got [list $name]!" } set fsl [Find $name] if {[file exists $fsl]} { Error "File already exists! $fsl" } Mkdir $name Log "Cloning" $url $fsl Fossil clone $url $fsl cd $name Log "Opening in" [pwd] Fossil open $fsl } proc open {name} { Mkdir $name cd $name Log "Opening in" [pwd] Fossil open [Find $name] } proc commit {args} { # strip git-ism: if {[lindex $args 0] eq "-am" && [llength $args] eq 2} { lset args 0 "-m" } # move -m to the front set i [lsearch -exact $args -m] if {$i > 0} { set a0 [lrange $args $i $i+1] set args [lreplace $args $i $i+1] set args [linsert $args 0 {*}$a0] } Fossil commit {*}$args } # pull might as well checkout current branch's leaf: proc pull {args} { if {$args eq ""} { Fossil pull Fossil checkout [F:currrent-branch] } } # support a really useful git-ism proc show {hash} { set parent [F:parent $hash] Fossil diff --from $parent --to $hash } namespace export {[a-z]*} namespace ensemble create -unknown [namespace which Unknown] } exit [main {*}$argv]