Fossil Wrapper

# -*-tcl-*-
# vi: ft=tcl ts=4 sw=4 et wm=0 tw=0

# -- Aliases:

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

alias tags     {tag list}
alias branches {branch list}

# -- Filters:

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

# 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 highlight_branch {branch} {
    expr {[regexp {^\* } $line] ? [coloured yellow $line] : $line}
}

filter fancy_timeline {leaves timeline} {
    if {[regexp "^=== .* ===" $line]} {
        return [coloured green $line]
    }
    # Expressions to match:
    set artifact_rx  {\[([a-f\d]{4})([^\]]*)\]}
    set date_rx      {^\d\d:\d\d:\d\d}
    set current_rx   {\*CURRENT\*}
    set branch_rx    {\*(MERGE|BRANCH)\*}
    # Colour the output (repeated substitutions on $line):
    set line [regsub -all $artifact_rx $line\
        [format {[%s%s]}\
            [coloured yellow [display bright {\1}]]\
            [coloured yellow {\2}]]]
    set line [regsub $date_rx    $line [coloured blue &]]
    set line [regsub $current_rx $line [display reversed &]]
    set line [regsub $branch_rx  $line [display bright &]]
    # Values for user and tags may wrap, so left uncoloured:
    regsub -all {(user:|tags:)\s+} $line [coloured yellow &]
}

# -- Interceptors:

# fsl cr:eate [password]
# 1. Creates a new fossil repository in ~/Repositories named by the working
#    directory, using ~/Repositories/skeleton.fossil for default settings.
# 2. Opens the new repository.
# 3. If the optional password is given, changes the default Fossil-provided
#    password for the user account matching the logged-in user.
# 4. Opens a new branch tagged "development".
# 5. Switches to that new branch for future work.
interceptor cr:create {
    global tcl_platform

    set repodir  [file join [file normalize ~] Repositories]
    set reponame [file join $repodir [file tail [pwd].fossil]]
    set skeleton [file join $repodir skeleton.fossil]

    set user     $tcl_platform(user)
    set password [lindex $params 1]

    fossil new $reponame --template $skeleton
    fossil open $reponame

    if {$password != ""} {
        fossil user password $user $password
    }

    fossil branch new development trunk
    fossil update development

    return {}
}

# fsl dup:licate url [password]
# 1. Clones a fossil repository at the provided URL into ~/Repositories, naming
#    it  by the working directory.
# 2. Opens the new repository.
# 3. If the optional password is given, changes the default Fossil-provided
#    password for the user account matching the logged-in user.
interceptor dup:duplicate {
    global tcl_platform

    set repodir  [file join [file normalize ~] Repositories]
    set reponame [file join $repodir [file tail [pwd].fossil]]

    set user     $tcl_platform(user)
    set url      [lindex $params 1]
    set password [lindex $params 2]

    fossil clone $url $reponame
    fossil open $reponame

    fossil user new $user
    if {$password != ""} {
        fossil user password $user $password
    }

    return {}
}

interceptor fil:filters {
    puts "Currently defined filters:"
    dict for {filter body} $config::filters {
        puts [format "%12s -> %s" $filter [string trim $body]]
    }
}

interceptor int:interceptors {
    puts "Currently defined interceptors:\n"
    set seen {}
    dict for {interceptor fn} $config::commands {
        dict lappend seen $fn $interceptor
    }
    dict for {interceptor groups} $seen {
        set disjunction [regsub -all " " $groups "|"]
        puts "$disjunction: [lindex $interceptor 1]"
    }
}