Fossil Wrapper

Artifact f57c7ecf8c4db2a9990b40ee21e7637a1374f45e:

• Executable file fsl — part of check-in [44509bee4b] at 2012-12-11 09:32:51 on branch trunk — Initial commit of wrapper script and license. (user: marc size: 4534)

#!/usr/bin/env expect
# -*-tcl-*-
#
# Copyright (c) 2012, Marc Simpson <marc@0branch.com> (ISC, see LICENSE)

# --( Aliases and Filters )---------------------------------------------

namespace eval config {
    set aliases {}
    set filters {};             # registered filters

    proc init {filename} {
        if {[file exists $filename]} {
            set conf [read [open $filename]]
        } else {
            set conf [unindent_script $config::defaults]
            puts "(Creating $filename)"
            puts [open $filename w] $conf
        }
        uplevel #0 [namespace eval fslrc $conf]
    }
}

# Add a new filter on `commands' named `name' (creates proc):
proc filter {name commands body} {
    set caller_ns [uplevel 1 {namespace current}]
    set namespaced "${caller_ns}::$name"
    uplevel 1 [list proc $name line $body]
    foreach command $commands {
        dict append config::filters $command " $namespaced"
    }
}

proc alias {name target} {
    dict append config::aliases $name $target
}

# Utility function usage:
#
#     alias ? help
#
#     filter indent help {
#         return "\t$line"
#     }

set config::defaults {
    # -*-tcl-*-

    # -- Aliases:

    alias  .      changes
    alias  d      diff
    alias  ,      ui
    alias  log    timeline
    alias  heads  leaves;       # for hg refugees

    # -- Filters:

    filter status {changes status timeline add rm addremove} {
        lassign [split [string trim $line]] status
        switch $status {
            ADDED   { coloured green $line }
            EDITED  { coloured  cyan $line }
            DELETED { coloured   red $line }
            default {            set  line }
        }
    }

    filter log_entry {leaves timeline} {
        if {[regexp "^=== .* ===" $line]} {
            coloured blue $line
        } else {
            regsub -all {\[[A-Fa-f0-9]+\]} $line [coloured yellow &]
        }
    }

    # Filter on alias `d' instead of `diff' so that output can be
    # redirected to create patch files.
    filter diff {d} {
        switch -regexp $line {
            {^-}    { coloured    red $line }
            {^\+}   { coloured  green $line }
            {^@@}   { coloured yellow $line }
            default {             set  line }
        }
    }
}

# --( Filter chains )---------------------------------------------------

proc chain_for {trigger} {
    if {[filter? $trigger]} {
        dict get $config::filters $trigger
    }
}

proc filter_with {chain line}  {
    if {![empty? $chain]} {
        foreach filter $chain {
            set line [$filter $line]
        }
        puts -nonewline $line
    }
}

# --( Utilities )-------------------------------------------------------

proc prefix? {pre str} {
    string equal -length [string length $pre] $str $pre
}

proc empty? {xs} {
    expr {[llength $xs] == 0}
}

proc unindent_script {script} {
    regexp "^ *" [set trimmed [string trim $script \n]] indent
    regsub -line -all "^$indent" $trimmed ""
}

proc coloured {colour text} {
    set colours {
        black  30        red    31        green  32
        yellow 33        blue   34        purple 35
        cyan   36        grey   37
    }
    if {[dict exists $colours $colour]} {
        set code [dict get $colours $colour]
        return "\[0;${code}m$text\[0m"
    } else {
        return $text
    }
}

proc alias?  {name} { dict exists $config::aliases $name }
proc filter? {name} { dict exists $config::filters $name }

# --( Entry )-----------------------------------------------------------

config::init ~/.fslrc

set candidate [lindex $argv 0]; # candidate for expansion

# Placeholder help:
if {![empty? $candidate] && [prefix? $candidate "wrapper"]} {
    puts [concat "Aliases: " [dict keys $config::aliases]]
    puts [concat "Filters: " [dict keys $config::filters]]
    exit 0
}

# Alias expansion:
set command $candidate
if {[alias? $candidate]} {
    set expansion [dict get $config::aliases $candidate]
    set command [lindex $expansion 0]
    set argv [concat $expansion [lrange $argv 1 end]]
}

# Prepare filters:
set chain [chain_for $candidate]
set chain [expr {[empty? $chain] ? [chain_for $command] : $chain}]
if {![empty? $chain]} {
    log_user 0;                 # disable logging to stdout
}

# Call to `fossil' binary:
spawn -noecho fossil {*}$argv
while 1 {
    expect {
        eof { break }
        \n  { filter_with $chain $expect_out(buffer) }
        # Transfer control to user following prompt:
        -re {[\?:] $} { interact; break }
    }
}