tkdiff

TKCVS Source Code For CVS。

#!/bin/sh
#-*-tcl-*-
# the next line restarts using wish \
exec wish "$0" -- ${1+"$@"}

###############################################################################
#
# TkDiff -- A graphical front-end to diff for Unix and Windows.
# Copyright (C) 1994-1998 by John M. Klassa.
# Copyright (C) 1999-2001 by AccuRev Inc.
# Copyright (C) 2002-2005 by John M. Klassa.
#
# TkDiff Home Page: http://tkdiff.sourceforge.net
#
# Usage:  see "tkdiff -h" or "tkdiff --help"
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.        See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
###############################################################################

package require Tk 8.0

# Change to t for trace info on stderr
set g(debug) f

# get this out of the way -- we want to draw the whole user interface
# behind the scenes, then pop up in all of its well-laid-out glory
set screenWidth [winfo vrootwidth .]
set screenHeight [winfo vrootheight .]
wm withdraw .

# set a couple o' globals that we might need sooner than later
set g(name) "TkDiff"
set g(version) "4.1.3"
set g(started) 0

# FIXME - move to preferences
option add "*TearOff" false 100
option add "*BorderWidth" 1 100
option add "*ToolTip.background" LightGoldenrod1
option add "*ToolTip.foreground" black

# determine the windowing platform, since there are different ways to
# do this for different versions of tcl
if {[catch {tk windowingsystem} g(windowingSystem)]} {
    if {"$::tcl_platform(platform)" == "windows"} {
        set g(windowingSystem) "win32"
    } elseif {"$::tcl_platform(platform)" == "unix"} {
        set g(windowingSystem) "x11"
    } elseif {"$::tcl_platform(platform)" == "macintosh"} {
        set g(windowingSystem) "classic"
    } else {
        # this should never happen, but just to be sure...
        set g(windowingSystem) "x11"
    }
}

# determine the name of the temporary directory and the name of
# the rc file, both of which are dependent on the platform.
# This is overridden by the preference in .tkdiffrc except for the very first
# time you run
switch -- $::tcl_platform(platform) {
windows {
        if {[info exists env(TEMP)]} {
            set opts(tmpdir) [file nativename $env(TEMP)]
        } else {
            set opts(tmpdir) C:/temp
        }
        set basercfile "_tkdiff.rc"
        # Native look for toolbar
        set opts(fancyButtons) 1
        set opts(relief) flat
    }
default {
        if {[info exists env(TMPDIR)]} {
            set opts(tmpdir) $env(TMPDIR)
        } else {
            set opts(tmpdir) /tmp
        }
        set basercfile ".tkdiffrc"
        # Native look for toolbar
        set opts(fancyButtons) 0
        set opts(relief) raised
    }
}

# compute preferences file location. Note that TKDIFFRC can hold either
# a directory or a file, though we document it as being a file name
if {[info exists env(TKDIFFRC)]} {
    set rcfile $env(TKDIFFRC)
    if {[file isdirectory $rcfile]} {
        set rcfile [file join $rcfile $basercfile]
    }
} elseif {[info exists env(HOME)]} {
    set rcfile [file join $env(HOME) $basercfile]
} else {
    set rcfile [file join "/" $basercfile]
}

# Try to find a pleasing native look for each platform.
# Fonts.
set sysfont [font actual system]
#debug-info "system font: $sysfont"

# See what the native menu font is
. configure -menu .native
menu .native
set menufont [lindex [.native configure -font] 3]
destroy .native

# Find out what the tk default is
label .testlbl -text "LABEL"
set labelfont [lindex [.testlbl configure -font] 3]
destroy .testlbl

text .testtext
set textfont [lindex [.testtext configure -font] 3]
destroy .testtext

entry .testent
set w(selcolor) [lindex [.testent configure -selectbackground] 4]
set entryfont [lindex [.testent configure -font] 3]
destroy .testent
# the above results in a nearly undistinguishable darker gray for the
# selected color (rh8 with tk 8.3.3-74) "#c3c3c3"
set w(selcolor) "#b03060"

# Make sure fon size is specified in points not pixels.  AquaTk doesn't.
if {! [regexp -- {-} $labelfont]} {
    regsub { (\d+)} $labelfont { -\1} labelfont
}
if {! [regexp -- {-} $menufont]} {
    regsub { (\d+)} $menufont { -\1} menufont
}
if {! [regexp -- {-} $textfont]} {
    regsub { (\d+)} $textfont { -\1} textfont
}
if {! [regexp -- {-} $entryfont]} {
    regsub { (\d+)} $entryfont { -\1} entryfont
}
#debug-info "menufont $menufont"
#debug-info "labelfont $labelfont"
#debug-info "textfont $textfont"
#debug-info "entryfont $entryfont"

set font [list $textfont]
set bold [list [concat $textfont bold]]
#debug-info "font: $font"
#debug-info "bold: $bold\n"
option add *Label.font $labelfont userDefault
option add *Button.font $labelfont userDefault
option add *Menu.font $menufont userDefault
option add *Entry.font $entryfont userDefault

# This makes tk_messageBox use our font.  The default tends to be terrible
# no matter what platform
option add *Dialog.msg.font $labelfont userDefault

# Initialize arrays
array set g {
    ancfileset      0
    conflictset     0
    ancfile         ""
    changefile      "tkdiff-change-bars.out"
    destroy         ""
    ignore_event,1  0
    ignore_event,2  0
    ignore_hevent,1 0
    ignore_hevent,2 0
    initOK          0
    mapborder       0
    mapheight       0
    mergefile       ""
    returnValue     0
    showmerge       0
    started         0
    mergefileset    0
    tempfiles       ""
    thumbMinHeight  10
    thumbHeight     10
    thumbDeltaY     0
}

array set finfo {
    f,1          ""
    f,2          ""
    pth,1        ""
    pth,2        ""
    revs,1       ""
    revs,2       ""
    lbl,1        ""
    lbl,2        ""
    userlbl,1    ""
    userlbl,2    ""
    title        {}
    tmp,1        0
    tmp,2        0
}
set uniq 0

# These options may be changed at runtime
array set opts {
    autocenter        1
    autoselect        0
    colorcbs          0
    customCode        {}
    diffcmd           "diff"
    ignoreblanksopt   "-b"
    ignoreblanks      0
    editor            ""
    geometry          "80x30"
    showcbs           1
    showln            1
    showmap           1
    showlineview      0
    showinline1       0
    showinline2       1
    syncscroll        1
    toolbarIcons      1
    tagcbs            0
    tagln             0
    tagtext           1
    tabstops          8
}

# reporting options
array set report {
    doSideLeft                0
    doLineNumbersLeft         1
    doChangeMarkersLeft       1
    doTextLeft                1
    doSideRight               1
    doLineNumbersRight        1
    doChangeMarkersRight      1
    doTextRight               1
    filename                  "tkdiff.out"
}

if {[string first "color" [winfo visual .]] >= 0} {
    # We have color
    # (but, let's not go crazy...)

    set colordel Tomato
    set colorins PaleGreen
    set colorchg DodgerBlue

    array set opts [subst {
        textopt    "-background white -foreground black -font $font"
        currtag    "-background Khaki"
        difftag    "-background gray"
        deltag     "-background $colordel -font $bold"
        instag     "-background $colorins -font $bold"
        chgtag     "-background LightSteelBlue"
        overlaptag "-background yellow"
        bytetag    "-background blue -foreground white"
        inlinetag  "-background $colorchg -font $bold"
        -          "-background $colordel -foreground $colorins"
        +          "-background $colorins -foreground $colordel"
        !          "-background $colorchg -foreground $colorchg"
        ?          "-background yellow -foreground yellow"
        mapins     "$colorins"
        mapdel     "$colordel"
        mapchg     "$colorchg"
    }]

} else {
    # Assume only black and white
    set bg "black"
    array set opts [subst {
        textopt    "-background white -foreground black -font $font"
        currtag    "-background black -foreground white"
        difftag    "-background white -foreground black -font $bold"
        deltag     "-background black -foreground white"
        instag     "-background black -foreground white"
        chgtag     "-background black -foreground white"
        overlaptag "-background black -foreground white"
        bytetag    "-underline 1"
        inlinetag  "-underline 1"
        -          "-background black -foreground white"
        +          "-background black -foreground white"
        !          "-background black -foreground white"
        ?          "-background black -foreground white"
        mapins     "black"
        mapdel     "black"
        mapchg     "black"
    }]
}

# make sure wrapping is turned off. This might piss off a few people,
# but it would screw up the display to have things wrap
set opts(textopt) "$opts(textopt) -wrap none"

# This proc is used in the rc file
proc define {name value} {
    global opts
    set opts($name) $value
}

# Source the rc file, which may override some of the defaults
# Any errors will be reported. Before doing so, we need to define the
# "define" proc, which lets the rc file have a slightly more human-friendly
# interface. Old-style .rc files should still load just fine for now, though
# it ought to be noted new .rc files won't be able to be processed by older
# versions of TkDiff. That shouldn't be a problem.
if {[file exists $rcfile]} {
    if {[catch {source $rcfile} error]} {
        set startupError [join [list "There was an error in processing your \
          startup file." "\n$g(name) will still run, but some of your \
          preferences" "\nmay not be in effect." "\n\nFile: $rcfile" \
          "\nError: $error"] " "]
    }
}

# a hack to handle older preferences files...
# if the user has a diffopt defined in their rc file, we'll magically
# convert that to diffcmd...
if {[info exists opts(diffopt)]} {
    set opts(diffcmd) "diff $opts(diffopt)"
}

# Work-around for bad font approximations,
# as suggested by Don Libes ([e-mail]).
catch {tk scaling [expr {100.0 / 72}]}

###############################################################################
#
# HERE BEGIN THE PROCS
###############################################################################

###############################################################################
# Exit with proper code
###############################################################################
proc do-exit {{returncode {}}} {
    debug-info "do-exit ($returncode)"
    global g

    # we don't particularly care if del-tmp fails.
    catch {del-tmp}
    if {$returncode == ""} {
        set returncode $g(returnValue)
    }
    # exit with an appropriate return value
    exit $returncode
}

###############################################################################
# Modal error dialog.
###############################################################################
proc do-error {msg} {
    global g

    debug-info "do-error ($msg)"
    tk_messageBox -message "$msg" -title "$g(name): Error" -icon error -type ok
}

###############################################################################
# Throw up a modal error dialog or print a message to stderr.  For
# Unix we print to stderr and exit if the main window hasn't been
# created, otherwise put up a dialog and throw an exception.
###############################################################################
proc fatal-error {msg} {
    debug-info "fatal-error ($msg)"
    global g tcl_platform

    if {$g(started)} {
        tk_messageBox -title "Error" -icon error -type ok -message $msg
        do-exit 2
    } else {
        puts stderr $msg