tkdiff

TKCVS Source Code For CVS。

      [list $w(LeftText) xview]

    scrollbar $w(RightHSB) -borderwidth 1 -orient horizontal -command \
      [list $w(RightText) xview]

    scrollbar $w(LeftVSB) -borderwidth 1 -orient vertical -command \
      [list $w(LeftText) yview]

    scrollbar $w(RightVSB) -borderwidth 1 -orient vertical -command \
      [list $w(RightText) yview]


    text $w(LeftText) -padx 0 -wrap none -width $width -height $height \
      -borderwidth 0 -setgrid 1 -yscrollcommand [list vscroll-sync \
      "$w(LeftInfo) $w(LeftCB)" 1] -xscrollcommand [list hscroll-sync 1]

    text $w(RightText) -padx 0 -wrap none -width $width -height $height \
      -borderwidth 0 -setgrid 1 -yscrollcommand [list vscroll-sync \
      "$w(RightInfo) $w(RightCB)" 2] -xscrollcommand [list hscroll-sync 2]

    text $w(LeftInfo) -height 0 -padx 0 -width 6 -borderwidth 0 -setgrid 1 \
      -yscrollcommand [list vscroll-sync "$w(LeftCB) $w(LeftText)" 1]

    text $w(RightInfo) -height 0 -padx 0 -width 6 -borderwidth 0 -setgrid 1 \
      -yscrollcommand [list vscroll-sync "$w(RightCB) $w(RightText)" 2]

    # each and every line in a text window will have a corresponding line
    # in this widget. And each line in this widget will be composed of
    # a single character (either "+", "-" or "!" for insertion, deletion
    # or change, respectively
    text $w(LeftCB) -height 0 -padx 0 -highlightthickness 0 -wrap none \
      -foreground white -width 1 -borderwidth 0 -yscrollcommand \
      [list vscroll-sync "$w(LeftInfo) $w(LeftText)" 1]

    text $w(RightCB) -height 0 -padx 0 -highlightthickness 0 -wrap none \
      -background white -foreground white -width 1 -borderwidth 0 \
      -yscrollcommand [list vscroll-sync "$w(RightInfo) $w(RightText)" 2]

    # this widget is the two line display showing the current line, so
    # one can compare character by character if necessary.
    text $w(BottomText) -wrap none -borderwidth 1 -height 2 -width 0

    # this is how we highlight bytes that are different...
    # the bottom window (lineview) uses reverse video to highlight
    # diffs, so we need to figure out what reverse video is, and
    # define the tag appropriately
    eval $w(BottomText) tag configure diff $opts(bytetag)

    # Set up text tags for the 'current diff' (the one chosen by the 'next'
    # and 'prev' buttons) and any ol' diff region.  All diff regions are
    # given the 'diff' tag initially...         As 'next' and 'prev' are \
        pressed,
    # to scroll through the differences, one particular diff region is
    # always chosen as the 'current diff', and is set off from the others
    # via the 'diff' tag -- in particular, so that it's obvious which diffs
    # in the left and right-hand text widgets match.

    foreach widget [list $w(LeftText) $w(LeftInfo) $w(LeftCB) $w(RightText) \
      $w(RightInfo) $w(RightCB)] {
        eval "$widget configure $opts(textopt)"
        foreach tag {difftag currtag inlinetag deltag instag chgtag \
          overlaptag + - ! ?} {
            eval "$widget tag configure $tag $opts($tag)"
        }
    }

    # adjust the tag priorities a bit...
    foreach window [list LeftText RightText LeftCB RightCB LeftInfo RightInfo] {
        $w($window) tag raise deltag currtag
        $w($window) tag raise chgtag currtag
        $w($window) tag raise instag currtag
        $w($window) tag raise currtag difftag
        $w($window) tag raise inlinetag
    }

    # these tags are specific to change bars
    foreach widget [list $w(LeftCB) $w(RightCB)] {
        eval "$widget tag configure + $opts(+)"
        eval "$widget tag configure - $opts(-)"
        eval "$widget tag configure ! $opts(!)"
        eval "$widget tag configure ? $opts(?)"
    }

    # build the map...
    # we want the map to be the same width as a scrollbar, so we'll
    # steal some information from one of the scrollbars we just
    # created...
    set cwidth [winfo reqwidth $w(LeftVSB)]
    set ht [$w(LeftVSB) cget -highlightthickness]
    set cwidth [expr {$cwidth -($ht*2)}]
    set color [$w(LeftVSB) cget -troughcolor]

    set map [frame $w(client).map -bd 1 -relief sunken -takefocus 0 \
      -highlightthickness 0]

    # now for the real map...
    image create photo map

    canvas $w(mapCanvas) -width [expr {$cwidth + 1}] \
      -yscrollcommand map-resize -background $color -borderwidth 0 \
      -relief sunken -highlightthickness 0
    $w(mapCanvas) create image 1 1 -image map -anchor nw
    pack $w(mapCanvas) -side top -fill both -expand y

    # I'm not too pleased with these bindings -- it results in a rather
    # jerky, cpu-intensive maneuver since with each move of the mouse
    # we are finding and tagging the nearest diff. But, what *should*
    # it do?
    #
    # I think what I *want* it to do is update the combobox and status
    # bar so the user can see where in the scheme of things they are,
    # but not actually select anything until they release the mouse.
    bind $w(mapCanvas) <ButtonPress-1> [list handleMapEvent B1-Press %y]
    bind $w(mapCanvas) <Button1-Motion> [list handleMapEvent B1-Motion %y]
    bind $w(mapCanvas) <ButtonRelease-1> [list handleMapEvent B1-Release %y]

    # this is a grip for resizing the sides relative to each other.
    button $w(client).grip -borderwidth 3 -relief raised \
      -cursor sb_h_double_arrow -image resize
    bind $w(client).grip <B1-Motion> {pane_drag $w(client) %X}

    # use grid to manage the widgets in the left side frame
    grid $w(LeftVSB) -row 0 -column 0 -sticky ns
    grid $w(LeftInfo) -row 0 -column 1 -sticky nsew
    grid $w(LeftCB) -row 0 -column 2 -sticky ns
    grid $w(LeftText) -row 0 -column 3 -sticky nsew
    grid $w(LeftHSB) -row 1 -column 1 -sticky ew -columnspan 3

    grid rowconfigure $leftFrame 0 -weight 1
    grid rowconfigure $leftFrame 1 -weight 0

    grid columnconfigure $leftFrame 0 -weight 0
    grid columnconfigure $leftFrame 1 -weight 0
    grid columnconfigure $leftFrame 2 -weight 0
    grid columnconfigure $leftFrame 3 -weight 1

    # likewise for the right...
    grid $w(RightVSB) -row 0 -column 3 -sticky ns
    grid $w(RightInfo) -row 0 -column 0 -sticky nsew
    grid $w(RightCB) -row 0 -column 1 -sticky ns
    grid $w(RightText) -row 0 -column 2 -sticky nsew
    grid $w(RightHSB) -row 1 -column 0 -sticky ew -columnspan 3

    grid rowconfigure $rightFrame 0 -weight 1
    grid rowconfigure $rightFrame 1 -weight 0

    grid columnconfigure $rightFrame 0 -weight 0
    grid columnconfigure $rightFrame 1 -weight 0
    grid columnconfigure $rightFrame 2 -weight 1
    grid columnconfigure $rightFrame 3 -weight 0

    # use grid to manage the labels, frames and map. We're going to
    # toss in an extra row just for the benefit of our dummy frame.
    # the intent is that the dummy frame will match the height of
    # the horizontal scrollbars so the map stops at the right place...
    grid $w(LeftLabel) -row 0 -column 0 -sticky ew
    grid $w(RightLabel) -row 0 -column 2 -sticky ew
    grid $leftFrame -row 1 -column 0 -sticky nsew -rowspan 2
    grid $map -row 1 -column 1 -stick ns
    grid $w(client).grip -row 2 -column 1
    grid $rightFrame -row 1 -column 2 -sticky nsew -rowspan 2

    grid rowconfigure $w(client) 0 -weight 0
    grid rowconfigure $w(client) 1 -weight 1
    grid rowconfigure $w(client) 2 -weight 0
    grid rowconfigure $w(client) 3 -weight 0

    if {$tk_version < 8.4} {
      grid columnconfigure $w(client) 0 -weight 1
      grid columnconfigure $w(client) 2 -weight 1
    } else {
      grid columnconfigure $w(client) 0 -weight 100 -uniform a
      grid columnconfigure $w(client) 2 -weight 100 -uniform a
    }
    grid columnconfigure $w(client) 1 -weight 0

    # this adjusts the variable g(activeWindow) to be whatever text
    # widget has the focus...
    bind $w(LeftText) <1> {set g(activeWindow) $w(LeftText)}
    bind $w(RightText) <1> {set g(activeWindow) $w(RightText)}

    set g(activeWindow) $w(LeftText) ;# establish a default

    rename $w(RightText) $w(RightText)_
    rename $w(LeftText) $w(LeftText)_

    proc $w(RightText) {command args} $::text_widget_proc
    proc $w(LeftText) {command args} $::text_widget_proc
}

###############################################################################
# Functionality: Inline diffs
# Athr: Michael D. Beynon : mdb - [e-mail]
# Date: 04/08/2003 : mdb - Added inline character diffs.
#       04/16/2003 : mdb - Rewrote longest-common-substring to be faster.
#                        - Added byte-by-byte algorithm.
#
# the recursive version is derived from the Ratcliff/Obershelp pattern
# recognition algorithm (Dr Dobbs July 1988), where we search for a
# longest common substring between two strings.  This match is used as
# an archor, around which we recursively do the same for the two left
# and two right remaining pieces (omitting the anchor).  This
# precisely determines the location of the intraline tags.
#################################################################################
proc longest-common-substring {s1 off1 len1 s2 off2 len2 lcsoff1_ref \
  lcsoff2_ref} {
    upvar $lcsoff1_ref lcsoff1
    upvar $lcsoff2_ref lcsoff2
    set snippet ""

    set snippetlen 0
    set longestlen 0

    # extract just the search regions for efficiency in string searching
    set s1 [string range $s1 $off1 [expr $off1+$len1-1]]
    set s2 [string range $s2 $off2 [expr $off2+$len2-1]]

    set j 0

    while {1} {
        # increase size of matching snippet
        while {$snippetlen < $len2-$j} {
            set tmp "$snippet[string index $s2 [expr $j+$snippetlen]]"
            if {[string first $tmp $s1] == -1} {
                break
            }
            set snippet $tmp
            incr snippetlen
        }
        if {$snippetlen == 0} {
            # nothing starting at this position
            incr j
            if {$snippetlen >= $len2-$j} {
                break
            }
        } else {
            set tmpoff [string first $snippet $s1]
            if {$tmpoff != -1 && $snippetlen > $longestlen} {
                # new longest?
                set longest $snippet
                set longestlen $snippetlen
                set lcsoff1 [expr $off1+$tmpoff]
                set lcsoff2 [expr $off2+$j]
            }
            # drop 1st char of prefix, but keep size the same as longest
            if {$snippetlen >= $len2-$j} {
                break
            }
            set snippet "[string range $snippet 1 end][string index $s2 \
              [expr $j+$snippetlen]]"
            incr j
        }
    }
    return $longestlen
}

proc fid-ratcliff-aux {pos l1 l2 s1 off1 len1 s2 off2 len2} {
    global g

    if {$len1 <= 0 || $len2 <= 0} {
        if {$len1 == 0} {
            set g(scrinline,$pos,$g(scrinline,$pos)) [list r $l2 $off2 \
              [expr $off2+$len2]]
            incr g(scrinline,$pos)
        } elseif {$len2 == 0} {
            set g(scrinline,$pos,$g(scrinline,$pos)) [list l $l1 $off1 \
              [expr $off1+$len1]]
            incr g(scrinline,$pos)
        }
        return 0
    }
    set cnt 0
    set lcsoff1 -1
    set lcsoff2 -1

    set ret [longest-common-substring $s1 $off1 $len1 $s2 $off2 $len2 lcsoff1 \
      lcsoff2]


    if {$ret > 0} {
        set rightoff1 [expr $lcsoff1+$ret]
        set rightoff2 [expr $lcsoff2+$ret]

        incr cnt [expr 2*$ret]
        if {$lcsoff1 > $off1 || $lcsoff2 > $off2} {
            # left
            incr cnt [fid-ratcliff-aux $pos $l1 $l2 $s1 $off1 \
              [expr $lcsoff1-$off1] $s2 $off2 [expr $lcsoff2-$off2]]

        }
        if {$rightoff1<$off1+$len1 || $rightoff2<$off2+$len2} {
            # right
            incr cnt [fid-ratcliff-aux $pos $l1 $l2 $s1 $rightoff1 \
              [expr $off1+$len1-$rightoff1] $s2 $rightoff2 \
              [expr $off2+$len2-$rightoff2]]
        }
    } else {
        set g(scrinline,$pos,$g(scrinline,$pos)) [list r $l2 $off2 \
          [expr $off2+$len2]]
        incr g(scrinline,$pos)
        set g(scrinline,$pos,$g(scrinline,$pos)) [list l $l1 $off1 \
          [expr $off1+$len1]]
        incr g(scrinline,$pos)
    }
    return $cnt
}

proc find-inline-diff-ratcliff {pos l1 l2 s1 s2} {
    global g

    set len1 [string length $s1]
    set len2 [string length $s2]
    if {$len1 == 0 || $len2 == 0} {
        return 0
    }
    return [fid-ratcliff-aux $pos $l1 $l2 $s1 0 $len1 $s2 0 $len2]
}

proc find-inline-diff-byte {pos l1 l2 s1 s2} {
    global g

    set len1 [string length $s1]
    set len2 [string length $s2]
    if {$len1 == 0 || $len2 == 0} {
        return 0
    }

    set cnt 0

    set lenmin [min $len1 $len2]
    set size 0
    for {set i 0} {$i < $lenmin} {incr i} {
        if {$size > 0} {
            # in a diff section
            if {[string index $s1 $i] == [string index $s2 $i]} {
                # end of diff region
                set g(scrinline,$pos,$g(scrinline,$pos)) [list r $l2 \
                  [expr $i-$size] $i]
                incr g(scrinline,$pos)
                set g(scrinline,$pos,$g(scrinline,$pos)) [list l $l1 \
                  [expr $i-$size] $i]
                incr g(scrinline,$pos)
                set size 0
                incr cnt
            } else {
                incr size
            }
        } else {
            if {[string index $s1 $i] != [string index $s2 $i]} {
                set size 1
            }
        }
    }
    if {$size > 0} {
        # end of diff region
        set g(scrinline,$pos,$g(scrinline,$pos)) [list r $l2 [expr $i-$size] \
          $len2]
        incr g(scrinline,$pos)
        set g(scrinline,$pos,$g(scrinline,$pos)) [list l $l1 [expr $i-$size] \
          $len1]
        incr g(scrinline,$pos)
        incr cnt
    }
    return $cnt
}

###############################################################################
# the following code is used as the replacement body for the left and
# right widget procs. The purpose is to catch when the insertion point
# changes so we can update the line comparison window
###############################################################################

set text_widget_proc {
    global w
    set real "[lindex [info level [info level]] 0]_"
    set result [eval $real $command $args]
    if {$command == "mark"} {
        if {[lindex $args 0] == "set" &&