tkdiff

TKCVS Source Code For CVS。

    set finfo(pth,$index) [tmpfile $index]
    set finfo(tmp,$index) 1

    # NB: it would probably be a Good Thing to move the definition
    # of the various command to exec, to the preferences dialog.

    regsub -all {\$} $f {\$} f
    set dirname [file dirname $f]
    set tailname [file tail $f]

    debug-info " $f"
    # For CVS, if it isn't checked out there is neither a CVS nor RCS
    # directory.  It will however have a ,v suffix just like rcs.
    # There is not necessarily a RCS directory for RCS, either. The file
    # always has a ,v suffix.

    if {[file isdirectory [file join $dirname CVS]]} {
        set cmd "cvs"
        if {$::tcl_platform(platform) == "windows"} {
            append cmd ".exe"
        }
        set finfo(lbl,$index) "$f (CVS $rev)"
        debug-info "  Setting lbl $finfo(lbl,$index)"
        die-unless "exec $cmd update -p $cvsopt \"$f\"" "\"$finfo(pth,$index)\""
    } elseif {[file isdirectory [file join $dirname .svn]]} {
        set cmd "svn"
        if {$::tcl_platform(platform) == "windows"} {
            append cmd ".exe"
        }
        if {"$r" == "" || "$rev" == "rBASE"} {
            set finfo(lbl,$index) "$f (SVN BASE)"
            debug-info "  Setting lbl $finfo(lbl,$index)"
            die-unless "exec cat $dirname/.svn/text-base/$tailname.svn-base" \
              $finfo(pth,$index)
        } else {
            set finfo(lbl,$index) "$f (SVN $rev)"
            debug-info "  Setting lbl $finfo(lbl,$index)"
            die-unless "exec $cmd cat $svnopt $f" $finfo(pth,$index)
        }
    } elseif {[regexp {://} $f]} {
        # Subversion command can have the form
        # svn diff OLD-URL[@OLDREV] NEW-URL[@NEWREV]
        if {![regsub {^.*@} $f {} rev]} {
            set rev "HEAD"
        }
        regsub {@\d+$} $f {} path
        set finfo(lbl,$index) "$f"
        set cmd "svn"
        if {$::tcl_platform(platform) == "windows"} {
            append cmd ".exe"
        }
        if {"$rev" == ""} {
            set command "$cmd cat $path"
        } else {
            set command "$cmd cat -r$rev $path"
        }
        die-unless "exec $command" $finfo(pth,$index)
    } elseif {[file isdirectory [file join $dirname SCCS]]} {
        if {[sccs-is-bk]} {
            set cmd "bk"
            set opt $bkopt
            set finfo(lbl,$index) "$f (bitkeeper $rev)"
            debug-info "  Setting lbl $finfo(lbl,$index)"
        } else {
            set finfo(lbl,$index) "$f (SCCS $rev)"
            debug-info "  Setting lbl $finfo(lbl,$index)"
            set opt $sccsopt
            set cmd "sccs"
        }
        if {$::tcl_platform(platform) == "windows"} {
            append cmd ".exe"
        }
        die-unless "exec $cmd get -p $opt \"$f\"" "\"$finfo(pth,$index)\""
    } elseif {[file isdirectory [file join $dirname RCS]]} {
        set cmd "co"
        if {$::tcl_platform(platform) == "windows"} {
            append cmd ".exe"
        }
        set finfo(lbl,$index) "$f (RCS $rev)"
        debug-info "  Setting lbl $finfo(lbl,$index)"
        die-unless "exec $cmd -p$rcsopt \"$f\"" "\"$finfo(pth,$index)\""
    } elseif {[file exists [file join $dirname $tailname,v]]} {
        set cmd "co"
        if {$::tcl_platform(platform) == "windows"} {
            append cmd ".exe"
        }
        set finfo(lbl,$index) "$f (RCS $rev)"
        debug-info "  Setting lbl $finfo(lbl,$index)"
        die-unless "exec $cmd -p$rcsopt \"$f\"" \""$finfo(pth,$index)\""
    } elseif {[file exists [file join $dirname vcs.cfg]]} {
        set cmd "get"
        if {$::tcl_platform(platform) == "windows"} {
            append cmd ".exe"
        }
        set finfo(lbl,$index) "$f (PVCS $rev)"
        debug-info "  Setting lbl $finfo(lbl,$index)"
        die-unless "exec $cmd -p $pvcsopt \"$f\"" "\"$finfo(pth,$index)\""
        filterCRCRLF $finfo(pth,$index)
    } elseif {[info exists ::env(P4CLIENT)]} {
        set cmd "p4"
        if {$::tcl_platform(platform) == "windows"} {
            append cmd ".exe"
        }
        set finfo(lbl,$index) "$f (Perforce $rev)"
        debug-info "  Setting lbl $finfo(lbl,$index)"
        die-unless "exec $cmd print -q \"$p4file\"" "\"$finfo(pth,$index)\""
    } elseif {[info exists ::env(ACCUREV_BIN)]} {
        set cmd "accurev"
        if {$::tcl_platform(platform) == "windows"} {
            append cmd ".exe"
        }
        set finfo(lbl,$index) "$f ($acrev)"
        debug-info "  Setting lbl $finfo(lbl,$index)"
        die-unless "exec $cmd cat $acopt \"$f\"" "\"$finfo(pth,$index)\""
    } elseif {[info exists ::env(CLEARCASE_ROOT)]} {
        set cmd "cleartool"
        set finfo(lbl,$index) "$f (ClearCase $rev)"
        debug-info "  Setting lbl $finfo(lbl,$index)"
        catch {exec $cmd ls -s $f} ctls
        # get the path name to file minus the revision info
        # (either CHECKEDOUT or a number)
        if {![regexp {(\S+)/([^/]+)$} $ctls dummy path checkedout]} {
            puts "Couldn't parse ct ls output '$ctls'"
            exit
        }
        catch {exec $cmd lshistory -last 50 $f} ctlshistory
        set lines [split $ctlshistory "\n"]
        set predecessor ""
        # find the previous version
        if {$checkedout == "CHECKEDOUT" || $checkedout == 0} {
            if {$checkedout == 0} {
                set path [file dirname $path]
            }
            set pattern "create version \"($path/\[^/\]+)\""
        } else {
            incr checkedout -1
            set pattern "create version \"($path/$checkedout)\""
        }
        # search the history of the file for the latest version on our branch
        foreach l $lines {
            if {[regexp $pattern $l dummy predecessor]} {
                break
            }
        }
        if {$predecessor != ""} {
            set finfo(pth,$index) $predecessor
            debug-info "  Setting lbl from predecessor $finfo(lbl,$index)"
        } else {
            puts "Couldn't deal with $f, exiting..."
            exit
        }
    } else {
        fatal-error "File '$f' is not part of a revision control system"
    }
    # Header above each file - if user has specified -L, override
    #debug-info "  $finfo(lbl,$index)"
    if {$finfo(userlbl,$index) != {}} {
        set finfo(lbl,$index) $finfo(userlbl,$index)
        debug-info "  User label: $finfo(lbl,$index)"
    }
}

proc sccs-is-bk {} {
    set cmd [auto_execok "bk"]
    set result 0
    if {[string length $cmd] > 0} {
        if {![catch {exec bk root} error]} {
            set result 1
        }
    }
    return $result
}

###############################################################################
# Setup ordinary file
#   f            file name
#   index   index in finfo array
###############################################################################
proc get-file {f index} {
    debug-info "get-file ($f $index)"
    global finfo

    #set finfo(f,$index) $f
    if {[file exists $f] != 1} {
        fatal-error "File '$f' does not exist"
        return 1
    }
    if {[file isdirectory $f]} {
        fatal-error "'$f' is a directory"
        return 1
    }

    # Header above each file - use filename unless
    # user has specified one with -L
    set finfo(lbl,$index) "$f"
    debug-info "  Setting lbl  $finfo(lbl,$index)"
    if {$finfo(userlbl,$index) != {}} {
        set finfo(lbl,$index) $finfo(userlbl,$index)
        debug-info "  User label: $finfo(lbl,$index)"
    }
    set finfo(pth,$index) "$f"
    set finfo(tmp,$index) 0
    return 0
}

###############################################################################
# Read the commandline
###############################################################################
proc commandline {} {
    debug-info "commandline"
    global argv
    global argc
    debug-info "  argv: $argv"
    global finfo
    global opts
    global g

    set g(initOK) 0
    set argindex 0
    set revs 0
    set pths 0
    set lbls 0

    # Loop through argv, storing revision args in rev and file args in
    # finfo. revs and pths are counters.
    while {$argindex < $argc} {
        set arg [lindex $argv $argindex]
        switch -regexp -- $arg {
        "^-h" -
        "^--help" {
                do-usage cline
                exit 0
            }
        "^-a$" {
                incr argindex
                set g(ancfile) [lindex $argv $argindex]
            }
        "^-a.*" {
                set g(ancfile) [string range $arg 2 end]
            }
        "^-v$" -
        "^-r$" {
                incr argindex
                incr revs
                set finfo(revs,$revs) [lindex $argv $argindex]
            }
        "^-v.*" -
        "^-r.*" {
                incr revs
                set finfo(revs,$revs) [string range $arg 2 end]
            }
        "^-L$" {
                incr argindex
                incr lbls
                set finfo(userlbl,$lbls) [lindex $argv $argindex]
            }
        "^-L.*" {
                incr lbls
                set finfo(userlbl,$lbls) [string range $arg 2 end]
            }
        "^-conflict$" {
                set g(conflictset) 1
            }
        "^-o$" {
                incr argindex
                set g(mergefile) [lindex $argv $argindex]
            }
        "^-o.*" {
                set g(mergefile) [string range $arg 2 end]
            }
        "^-psn" {
                # Ignore the Carbon Process Serial Number
                set argv [lreplace $argv $argindex $argindex]
                incr argc -1
                incr argindex
            }
        "^-" {
                append opts(diffcmd) " $arg "
            }
        default {
                incr pths
                set finfo(pth,$pths) $arg
                set finfo(f,$pths) $arg
            }
        }
        incr argindex
    }

    # Add our counters to the global array
    # Now check how many revision and file args we have.
    debug-info "  $pths files, $revs revisions"
    # Maybe adjustment is needed
    if {$revs == 1 && $pths == 0} {
       # tkdiff -r FILE; same as tkdiff FILE
       set finfo(pths,1) $finfo(revs,1)
       set finfo(f,1) $finfo(revs,1)
       incr pths 1
       incr revs -1
       unset finfo(revs,1)
    } elseif {$revs == 2 && $pths == 0} {
       # tkdiff -rREV -r FILE; same as tkdiff -rREV FILE
       set finfo(pths,1) $finfo(revs,2)
       set finfo(f,1) $finfo(revs,2)
       incr pths 1
       incr revs -1
       unset finfo(revs,2)
    }
    # What have we got now?
    debug-info "  $pths files, $revs revisions"
    if {$revs == 0 && $pths == 0} {
        # Return "empty" flag, and we'll do a pop-up
        return 1
    } elseif {$revs > 1 && $pths != 1} {
        puts stderr "Error: you specified $pths file(s) and $revs revision(s)"
        do-usage cline
        exit 1
    }

    if {$g(mergefile) != ""} {
      set g(mergefileset) 1
    }
    return 0
}

###############################################################################
# Process the arguments, whether from the command line or from the dialog
###############################################################################
proc assemble-args {} {
    debug-info "assemble-args"
    global finfo
    global opts
    global g

    if {$g(ancfile) != ""} {
        set g(ancfileset) 1
    }
    debug-info " conflict: $g(conflictset)"
    debug-info " ancestor: $g(ancfileset) $g(ancfile)"
    debug-info " mergefile set: $g(mergefileset) $g(mergefile)"
    debug-info " diff command: $opts(diffcmd) "

    # Count up how many files and revs we got from the GUI or commandline
    set pths 0
    foreach p [array names finfo f,*] {
        if {$finfo($p) != ""} {
            incr pths
        }
    }
    set revs 0
    foreach r [array names finfo revs,*] {
        if {$finfo($r) != ""} {
            incr revs
        }
    }

    debug-info " $pths files, $revs revisions"
    if {$revs == 0 && $pths == 0} {
        return
    }
    if {$g(conflictset)} {
        if {$revs == 0 && $pths == 1} {
            ############################################################
            # tkdiff -conflict FILE
            ############################################################
            set files [split-conflictfile "$finfo(f,1)"]
            if {[get-file [lindex "$files" 0] 1]} {return}
            if {[get-file [lindex "$files" 1] 2]} {return}
            # A conflict file may come from merge, cvs, or vmrg.  The
            # names of the files/revisions depend on how it was made and
            # are taken from the <<<<<<< and >>>>>>> lines inside it.
            set finfo(lbl,1) [lindex "$files" 2]
            set finfo(lbl,2) [lindex "$files" 3]
        } else {
            fatal-error "Usage: tkdiff -conflict FILE"
        }
    } else {
        if {$revs == 2 && $pths == 1} {
            ############################################################
            #  tkdiff -rREV1 -rREV2 FILE
            ############################################################