tkdiff

TKCVS Source Code For CVS。

        del-tmp
        do-exit 2
    }
}

###############################################################################
# Return the name of a temporary file
###############################################################################
proc tmpfile {n} {
    debug-info "tmpfile ($n)"
    global g opts
    global uniq
    set uniq [expr ($uniq + 1) ]
    set tmpdir [file nativename $opts(tmpdir)]
    set tmpfile [file join $tmpdir "[pid]-$n-$uniq"]
    set access [list RDWR CREAT EXCL TRUNC]
    set perm 0600
    if {[catch {open $tmpfile $access $perm} fid ]} {
        # something went wrong
        error "Failed creating temporary file: $fid"
    }
    close $fid
    lappend g(tempfiles) $tmpfile
    return $tmpfile
}

###############################################################################
# Execute a command.
# Returns "$stdout $stderr $exitcode" if exit code != 0
###############################################################################
proc run-command {cmd} {
    debug-info "run-command ($cmd)"
    global opts errorCode

    set stderr ""
    set exitcode 0
    set errfile [tmpfile "r"]

    set failed [catch "$cmd \"2>$errfile\"" stdout]
    # Read stderr output
    catch {
        set hndl [open "$errfile" r]
        set stderr [read $hndl]
        close $hndl
    }
    if {$failed} {
        switch -- [lindex $errorCode 0] {
        "CHILDSTATUS" {
                set exitcode [lindex $errorCode 2]
            }
        "POSIX" {
                if {$stderr == ""} {
                    set stderr $stdout
                }
                set exitcode -1
            }
        default {
                set exitcode -1
            }
        }
    }

    catch {file delete $errfile}
    return [list "$stdout" "$stderr" "$exitcode"]
}

###############################################################################
# Execute a command.  Die if unsuccessful.
###############################################################################
proc die-unless {cmd file} {
    #debug-info "die-unless ($cmd $file)"
    global opts errorCode

    set file [string trim $file "\""]
    set result [run-command "$cmd \">$file\""]
    set stdout [lindex $result 0]
    set stderr [lindex $result 1]
    set exitcode [lindex $result 2]

    if {$exitcode != 0} {
        fatal-error "$stderr\n$stdout"
    }
}

###############################################################################
# Filter PVCS output files that have CR-CR-LF end-of-lines
###############################################################################
proc filterCRCRLF {file} {
    debug-info "filterCRCLF ($file)"
    set outfile [tmpfile 9]
    set inp [open $file r]
    set out [open $outfile w]
    fconfigure $inp -translation binary
    fconfigure $out -translation binary
    set CR [format %c 13]
    while {![eof $inp]} {
        set line [gets $inp]
        if {[string length $line] && ![eof $inp]} {
            regsub -all "$CR$CR" $line $CR line
            puts $out $line
        }
    }
    close $inp
    close $out
    file rename -force $outfile $file
}

###############################################################################
# Return the smallest of two values
###############################################################################
proc min {a b} {
    return [expr {$a < $b ? $a : $b}]
}

###############################################################################
# Return the largest of two values
###############################################################################
proc max {a b} {
    return [expr {$a > $b ? $a : $b}]
}

###############################################################################
# Toggle change bars
###############################################################################
proc do-show-changebars {{show {}}} {
    debug-info "do-show-changebars ($show)"
    global opts
    global w

    if {$show != {}} {
        set opts(showcbs) $show
    }

    if {$opts(showcbs)} {
        grid $w(LeftCB) -row 0 -column 2 -sticky ns
        grid $w(RightCB) -row 0 -column 1 -sticky ns
    } else {
        grid forget $w(LeftCB)
        grid forget $w(RightCB)
    }
}

###############################################################################
# Toggle ignore white spaces
###############################################################################
proc do-show-ignoreblanks {{showIgn {}}} {
    global opts
    global finfo

    if {$showIgn != {}} {
        set opts(ignoreblanks) $showIgn
    }
    if {$finfo(pth,1) != {} && $finfo(pth,2) != {}} {
        recompute-diff
    }
}

###############################################################################
# Toggle line numbers.
###############################################################################
proc do-show-linenumbers {{showLn {}}} {
    global opts
    global w

    if {$showLn != {}} {
        set opts(showln) $showLn
    }

    if {$opts(showln)} {
        grid $w(LeftInfo) -row 0 -column 1 -sticky nsew
        grid $w(RightInfo) -row 0 -column 0 -sticky nsew
    } else {
        grid forget $w(LeftInfo)
        grid forget $w(RightInfo)
    }
}

###############################################################################
# Show line numbers in info windows
###############################################################################
proc draw-line-numbers {} {
    global g
    global w

    $w(LeftInfo) configure -state normal
    $w(RightInfo) configure -state normal
    $w(LeftCB) configure -state normal
    $w(RightCB) configure -state normal

    set lines(Left) [lindex [split [$w(LeftText) index end-1lines] .] 0]
    set lines(Right) [lindex [split [$w(RightText) index end-1lines] .] 0]

    # Smallest line count
    set minlines [min $lines(Left) $lines(Right)]

    # cache all the blank lines for the info and cb windows, and do
    # one big insert after we're done. This seems to be much quicker
    # than inserting them in the widgets one line at a time.
    set linestuff {}
    set cbstuff {}
    for {set i 1} {$i < $minlines} {incr i} {
        append linestuff "$i\n"
        append cbstuff " \n" ;# for now, just put in place holders...
    }

    $w(LeftInfo) insert end $linestuff
    $w(RightInfo) insert end $linestuff
    $w(LeftCB) insert end $cbstuff
    $w(RightCB) insert end $cbstuff

    # Insert remaining line numbers. We'll cache the stuff to be
    # inserted so we can do just one call in to the widget. This
    # should be much faster, relatively speaking, then inserting
    # data one line at a time.
    foreach mod {Left Right} {
        set linestuff {}
        set cbstuff {}
        for {set i $minlines} {$i < $lines($mod)} {incr i} {
            append linestuff "$i\n"
            append cbstuff " \n" ;# for now, just put in place holders...
        }
        $w(${mod}Info) insert end $linestuff
        $w(${mod}CB) insert end $cbstuff
    }

    $w(LeftCB) configure -state disabled
    $w(RightCB) configure -state disabled

    $w(LeftInfo) configure -state disabled
    $w(RightInfo) configure -state disabled
}

###############################################################################
# Pop up a window for file merge.
###############################################################################
proc popup-merge {{writeproc merge-write-file}} {
    debug-info "popup-merge ($writeproc)"
    global g
    global w

    if {$g(mergefileset)} {
        $writeproc
        return
    }

    set types {
        {{Text Files}         {.txt}}
        {{All Files}         {*}}
    }

    set path [tk_getSaveFile -defaultextension "" -filetypes $types \
      -initialfile [file nativename $g(mergefile)]]

    if {[string length $path] > 0} {
        set g(mergefile) $path
        $writeproc
    }
}

###############################################################################
# Split a file containing CVS conflict markers into two temporary files
#    name        Name of file containing conflict markers
# Returns the names of the two temporary files and the names of the
# files that were merged
###############################################################################
proc split-conflictfile {name} {
    debug-info "conflicts ($name)"
    global g opts

    set first ${name}.1
    set second ${name}.2

    set temp1 [tmpfile 1]
    set temp2 [tmpfile 2]

    if {[catch {set input [open $name r]}]} {
        fatal-error "Couldn't open file '$name'"
    }
    set first [open $temp1 w]
    set second [open $temp2 w]

    set firstname ""
    set secondname ""
    set output 3

    set firstMatch ""
    set secondMatch ""
    set thirdMatch ""

    while {[gets $input line] >= 0} {
        if {$firstMatch == ""} {
            if {[regexp {^<<<<<<<* +(.*)} $line]} {
                set firstMatch {^<<<<<<<* +(.*)}
                set secondMatch {^=======*}
                set thirdMatch {^>>>>>>>* +(.*)}
            } elseif {[regexp {^>>>>>>>* +(.*)} $line]} {
                set firstMatch {^>>>>>>>* +(.*)}
                set secondMatch {^<<<<<<<* +(.*)}
                set thirdMatch {^=======*}
            }
        }
        if {$firstMatch != ""} {
            if {[regexp $firstMatch $line]} {
                set output 2
                if {$secondname == ""} {
                    regexp $firstMatch $line all secondname
                }
            } elseif {[regexp $secondMatch $line]} {
                set output 1
                if {$firstname == ""} {
                    regexp $secondMatch $line all firstname
                }
            } elseif {[regexp $thirdMatch $line]} {
                set output 3
                if {$firstname == ""} {
                    regexp $thirdMatch $line all firstname
                }
            } else {
                if {$output & 1} {
                    puts $first $line
                }
                if {$output & 2} {
                    puts $second $line
                }
            }
        } else {
            puts $first $line
            puts $second $line
        }
    }
    close $input
    close $first
    close $second

    if {$firstname == ""} {
        set firstname "old"
    }
    if {$secondname == ""} {
        set secondname "new"
    }

    return "{$temp1} {$temp2} {$firstname} {$secondname}"
}

###############################################################################
# Get a revision of a file
#   f            file name
#   index   index in finfo array
#   r            revision, "" for head revision
###############################################################################
proc get-file-rev {f index {r ""}} {
    debug-info "get-file-rev ($f $index \"$r\")"
    global finfo
    global opts
    global tcl_platform

    if {"$r" == ""} {
        set rev "HEAD"
        set acrev "HEAD"
        set acopt ""
        set cvsopt ""
        set svnopt ""
        set rcsopt ""
        set sccsopt ""
        set bkopt ""
        set pvcsopt ""
        set p4file "$f"
    } else {
        set rev "r$r"
        set acrev "\"$r\""
        set acopt "-v \"$r\""
        set cvsopt "-r $r"
        set svnopt "-r $r"
        set rcsopt "$r"
        set sccsopt "-r$r"
        set bkopt "-r$r"
        set pvcsopt "-r$r"
        set p4file "$f#$r"
    }