Fossil Wrapper

fslrc at [910c52f888]
Login

File fslrc artifact 7da725b5b7 part of check-in 910c52f888


1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324
# -*-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