Fossil Wrapper

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

# record: interactive commits
#
# We add two commands which provide interactive commits:
#
# - rec, record: interactive version of 'commit'
# - rst, rstash: interactive version of 'stash' when used with 'save'
#                are 'snapshot' subcommands
# - stash: accepts a --record option which works like 'rstash'


# askrecord question ask
# - ask == yes ... accept without question
# - ask == no  ... decline without question
# - otherwise  ... ask
#
# Return values
# - y ... do record
# - n ... do not record
# - s ... skip remaining changes of this file
# - d ... skip all remaining changes
# - f ... record remaining changes of this file
# - q ... abort, do not record anything
proc askrecord {question ask} {
    if {$ask == yes} { return f }
    if {$ask == no} { return n }
    while yes {
        puts -nonewline [coloured yellow "$question \[Ynsfdaq?\] "]
        flush stdout
        gets stdin answer
        if {$answer == {}} { set answer y }
        switch $answer {
            n { return n }
            s { return s }
            f { return f }
            d { return d }
            q { return q }
            y { return y }
            a { return a }
            ? {
                puts "y - yes, record this change"
                puts "n - no, do not record this change"
                puts "s - skip remaining changes to this file"
                puts "f - record remaining changes to this file"
                puts "d - done, skip remaining changes and files"
                puts "a - record all remaining changes to all remaining files"
                puts "q - quit, record no changes"
                puts "? - help, show this message"
            }
            default { puts "ERROR: invalid command" }
        }
    }
}

# colourizehunk hunk
# - hunk: a hunk of a diff to be colourized
#
# Returns the colourized hunk
#   - removals in red
#   - additions in green
#   - info lines in magenta
proc colourizehunk {hunk} {
    set result {}
    foreach line [split $hunk "\n"] {
        lappend result \
            [switch -regexp $line {
                {^-}       { coloured     red $line }
                {^\+}      { coloured   green $line }
                {^@@}      { coloured magenta $line }
                default    {              set  line }
            }]
    }
    return [join $result "\n"]
}

# recordhunks files params
# - files is a list of filenames to be recorded
# - params are additional parameters to the underlying command (e.g.
#   'commit')
#

# The function generates a unified diff of the specified files. The
# diff is split into files and hunks. Then the function asks
# interactive questions for each file and hunk to select those hunks
# that should be committed. The not selected hunks are use to build a
# patch. The inverse of this patch is applied to the working directory
# leaving only the selected changes. Then the underlying commit
# command is executed and afterwards the patch is used to restore the
# non-selected changes.
proc recordhunks {files params} {
    set rgxsplit {^(?:Index: .*$\n=+$\n)?^--- ([^\n]*)$\n^\+\+\+ ([^\n]*)$\n((^.+$\n)*)}
    set rgxhunk {^@@.*@@$\n((^[^@I].*$\n)*)}

    # get repo root
    set workdir [pwd]
    if {[llength $files] == 0} {
        catch {exec fossil info} inf
        regexp -line {local-root:\s*(\S.*)} $inf m workdir
    }

    # get diff and split into files and hunks
    catch {exec fossil diff -i -c 1 {*}$files} diff

    set files {}
    set start 0
    set nhunks 0
    while {[regexp -start $start -indices -line $rgxsplit $diff all inf outf hunk] == 1} {
        set htxt [string range $diff {*}$hunk]
        set hunks {}
        set hstart 0
        while {[regexp -start $hstart -indices -line $rgxhunk $htxt hall] == 1} {
            lappend hunks [string range $htxt {*}$hall]
            set hstart [lindex $hall 1]
        }
        lappend files [list \
                           [string range $diff {*}$inf] \
                           [string range $diff {*}$outf] \
                           $hunks]
        incr nhunks [llength $hunks]
        set start [lindex $all 1]
    }

    # iterate through files/hunks and ask some questions
    set recfiles {}
    set norecfiles {}
    set askfile ask
    set ifile 0
    set nfiles [llength $files]
    set ihunk 0
    foreach file $files {
        lassign $file inf outf hunks

        incr ifile
        set answer [askrecord "examine file '$inf' \[$ifile/$nfiles\]?" $askfile]
        set askhunk ask
        switch $answer {
            n { set askhunk no }
            s { set askhunk no }
            f { set askhunk yes }
            d {
                set askfile no
                set askhunk no
            }
            a {
                set askfile yes
                set askhunk yes
            }
            q { return {} }
        }

        set rechunks {}
        set norechunks {}
        foreach hunk $hunks {
            incr ihunk
            if {$askhunk == "ask"} {
                puts [colourizehunk $hunk]
            }
            set answer [askrecord "record hunk \[$ihunk/$nhunks\]?" $askhunk]
            switch $answer {
                y { set dorec yes }
                n { set dorec no }
                s {
                    set dorec no
                    set askhunk no
                }
                f {
                    set dorec yes
                    set askhunk yes
                }
                d {
                    set dorec no
                    set askfile no
                    set askhunk no
                }
                a {
                    set dorec yes
                    set askfile yes
                    set askhunk yes
                }
                q { return {} }
            }
            if $dorec {
                lappend rechunks $hunk
            } else {
                lappend norechunks $hunk
            }
        }

        if {[llength $rechunks] > 0} {
            lappend recfiles [list $inf $outf $rechunks]
        }
        if {[llength $norechunks] > 0} {
            lappend norecfiles [list $inf $outf $norechunks]
        }
    }

    set fh [open fsl-record.patch w 0600]
    puts $fh $diff
    close $fh

    # build patch of changed *not* selected
    set nopatch {}
    foreach file $norecfiles {
        lassign $file inf outf hunks
        lappend nopatch "--- $inf\n"
        lappend nopatch "+++ $outf\n"
        foreach hunk $hunks {
            lappend nopatch $hunk
        }
        lappend nopatch "\n"
    }
    set nopatch [join $nopatch {}]
    set fh [open fsl-norecord.patch w 0600]
    puts $fh $nopatch
    close $fh

    set dir [pwd]
    cd $workdir
    exec patch -p0 -R << $nopatch
    catch {fossil {*}$params}
    exec patch -p0 << $nopatch
    cd $dir
    
    file delete fsl-record.patch
    file delete fsl-norecord.patch

    return {}
}

# record: interactive version of 'commit'
interceptor rec:record {
    lset params 0 commit
    set files {}
    for {set i 1} {$i < [llength $params]} {incr i} {
        set p [lindex $params $i]
        switch -regexp $p {
            {^(-m|--message|-M|--message-file|--mimetype|--bgcolor|--branch|--branchcolor|--tag)$} { incr i }
            {^-} {}
            default { lappend files $p }
        }
    }
    return [recordhunks $files $params]
}

# rstash: interactive version of 'stash save' and 'stash snapshot'
interceptor rst:rstash {
    lset params 0 stash
    if {[llength $params] <= 1} {
        return [recordhunks {} $params]
    } elseif {[regexp {^(-.*|save|snapshot)$} [lindex $params 1]] == 1} {
        set files {}
        for {set i 2} {$i < [llength $params]} {incr i} {
            set p [lindex $params $i]
            switch -regexp $p {
                {^(-m|--comment)$} { incr i }
                {^-} {}
                default { lappend files $p }
            }
        }
        return [recordhunks $files $params]
    } else {
        return $params
    }
}

# stash --record: additional argument for stash for using interactive commits
interceptor stash {
    if {[regexp -indices -- {[[:blank:]]+(--record)} $params {} rec] == 1} {
        set params [string replace $params {*}$rec]
        lset params 0 rstash
        fossil {*}$params
        return {}
    } else {
        return $params
    }
}

# vim: ft=tcl