tkdiff

TKCVS Source Code For CVS。

            set f $finfo(f,1)
            get-file-rev "$f" 1 "$finfo(revs,1)"
            get-file-rev "$f" 2 "$finfo(revs,2)"

        } elseif {$revs == 1 && $pths == 1} {
            ############################################################
            #  tkdiff -rREV FILE
            ############################################################
            set f $finfo(f,1)
            get-file-rev "$f" 1 "$finfo(revs,1)"
            if {[get-file "$f" 2]} {return}

        } elseif {$revs == 0 && $pths == 2} {
            ############################################################
            #  tkdiff FILE1 FILE2
            ############################################################
            set f1 $finfo(f,1)
            set f2 $finfo(f,2)
            if {[file isdirectory $f1] && [file isdirectory $f2]} {
                fatal-error "Cannot diff two directories"
            }

            if {[file isdirectory $f1]} {
                set f1 [file join $f1 [file tail $f2]]
            } elseif {[file isdirectory $f2]} {
                set f2 [file join $f2 [file tail $f1]]
            }

            # Maybe they're Subversion URL paths, not local files
            if {[regexp {://} $f1]} {
                get-file-rev "$f1" 1
            } else {
                if {[get-file "$f1" 1]} {return}
            }
            if {[regexp {://} $f2]} {
                get-file-rev "$f2" 2
            } else {
                if {[get-file "$f2" 2]} {return}
            }


        } elseif {$revs == 0 && $pths == 1} {
            ############################################################
            #  tkdiff FILE
            ############################################################
            set f $finfo(f,1)
            get-file-rev "$f" 1
            if {[get-file "$f" 2]} {return}

        } else {
            do-error "Error: you specified $pths file(s) and $revs revision(s)"
            do-usage gui
            tkwait window .usage
            return 1
        }
    }

    set finfo(title) "[file tail $finfo(lbl,1)] vs. [file tail $finfo(lbl,2)]"
    debug-info "  Setting title $finfo(title)"
    set rootname [file rootname $finfo(pth,1)]
    #    set path          [file dirname          $finfo(pth,1)]
    set path [pwd]
    set suffix [file extension $finfo(pth,1)]
    if {! $g(mergefileset)} {
        set g(mergefile) [file join $path "${rootname}-merge$suffix"]
    }
    set g(initOK) 1
    foreach inf [lsort [array names finfo]] {
        debug-info "    $inf: $finfo($inf)"
    }
    debug-info " $revs revs  $pths files"

    wm title . "$finfo(title) - $g(name) $g(version)"
    return 0
}

###############################################################################
# Set up the display
###############################################################################
proc create-display {} {
    debug-info "create-display"

    global g opts bg tk_version
    global w
    global tmpopts

    # these are the four major areas of the GUI:
    # menubar - the menubar (duh)
    # toolbar - the toolbar (duh, again)
    # client  - the area with the text widgets and the graphical map
    # status us         - a bottom status line

    # this block of destroys is only for stand-alone testing of
    # the GUI code, and can be blown away (or not, if we want to
    # be able to call this routine to recreate the display...)
    catch {
        destroy .menubar
        destroy .toolbar
        destroy .client
        destroy .map
        destroy .status
    }

    # create the top level frames and store them in a global
    # array..
    set w(client) .client
    set w(menubar) .menubar
    set w(toolbar) .toolbar
    set w(status) .status

    # other random windows...
    set w(preferences) .pref
    set w(findDialog) .findDialog
    set w(popupMenu) .popupMenu

    # now, simply build all the pieces
    build-menubar
    build-toolbar
    build-client
    build-status
    build-popupMenu

    frame .separator1 -height 2 -borderwidth 2 -relief groove
    frame .separator2 -height 2 -borderwidth 2 -relief groove

    # ... and fit it all together...
    . configure -menu $w(menubar)
    pack $w(toolbar) -side top -fill x -expand n
    pack .separator1 -side top -fill x -expand n

    pack $w(client) -side top -fill both -expand y
    pack .separator2 -side top -fill x -expand n

    pack $w(status) -side bottom -fill x -expand n

    # apply user preferences by calling the proc that gets
    # called when the user presses "Apply" from the preferences
    # window. That proc uses a global variable named "tmpopts"
    # which should have the values from the dialog. Since we
    # aren't using the dialog, we need to populate this array
    # manually
    foreach key [array names opts] {
        set ::tmpopts($key) $opts($key)
    }
    apply 0

    # Make sure temporary files get deleted
    #bind . <Destroy> {del-tmp}

    # other misc. bindings
    common-navigation $w(LeftText) $w(LeftInfo) $w(LeftCB) $w(RightText) \
      $w(RightInfo) $w(RightCB)

    # normally, keyboard traversal using tab and shift-tab isn't
    # enabled for text widgets, since the default binding for these
    # keys is to actually insert the tab character. Because all of
    # our text widgets are for display only, let's redefine the
    # default binding so the global <Tab> and <Shift-Tab> bindings
    # are used.
    bind Text <Tab> {continue}
    bind Text <Shift-Tab> {continue}

    # if the user toggles scrollbar syncing, we want to make sure
    # they sync up immediately
    trace variable opts(syncscroll) w toggleSyncScroll
    wm deiconify .
    focus -force $w(RightText)
    update idletasks
    # Need this to make the pane-resizing behave
    grid propagate $w(client) f
}

###############################################################################
# when the user changes the "sync scrollbars" option, we want to
# sync up the left scrollbar with the right if they turn the option on
###############################################################################
proc toggleSyncScroll {args} {
    global opts
    global w

    if {$opts(syncscroll) == 1} {
        eval vscroll-sync {{}} 2 [$w(RightText) yview]
    }
}

###############################################################################
# show the popup menu, optionally changing some of the entries based on
# where the user clicked
###############################################################################
proc show-popupMenu {x y} {
    global w
    global g

    set window [winfo containing $x $y]
    if {[winfo class $window] == "Text"} {
        $w(popupMenu) entryconfigure "Find..." -state normal
        $w(popupMenu) entryconfigure "Find Nearest*" -state normal
        $w(popupMenu) entryconfigure "Edit*" -state normal

        if {$window == $w(LeftText) || $window == $w(LeftInfo) || $window == \
          $w(LeftCB)} {
            $w(popupMenu) configure -title "File 1"
            set g(activeWindow) $w(LeftText)
        } else {
            $w(popupMenu) configure -title "File 2"
            set g(activeWindow) $w(RightText)
        }

    } else {
        $w(popupMenu) entryconfigure "Find..." -state disabled
        $w(popupMenu) entryconfigure "Find Nearest*" -state disabled
        $w(popupMenu) entryconfigure "Edit*" -state disabled
    }
    tk_popup $w(popupMenu) $x $y
}

###############################################################################
# build the right-click popup menu
###############################################################################
proc build-popupMenu {} {
    debug-info "build-popupMenu"
    global w g

    # this routine assumes the other windows already exist...
    menu $w(popupMenu)
    foreach win [list LeftText RightText LeftInfo RightInfo LeftCB RightCB \
      mapCanvas] {
        bind $w($win) <3> {show-popupMenu %X %Y}
    }

    set m $w(popupMenu)
    $m add command -label "First Diff" -underline 0 -command [list popupMenu \
      first] -accelerator "f"
    $m add command -label "Previous Diff" -underline 0 -command \
      [list popupMenu previous] -accelerator "p"
    $m add command -label "Center Current Diff" -underline 0 -command \
      [list popupMenu center] -accelerator "c"
    $m add command -label "Next Diff" -underline 0 -command [list popupMenu \
      next] -accelerator "n"
    $m add command -label "Last Diff" -underline 0 -command [list popupMenu \
      last] -accelerator "l"
    $m add separator
    $m add command -label "Find Nearest Diff" -underline 0 -command \
      [list popupMenu nearest] -accelerator "Double-Click"
    $m add separator
    $m add command -label "Find..." -underline 0 -command [list popupMenu find]
    $m add command -label "Edit" -underline 0 -command [list popupMenu edit]
}

###############################################################################
# handle popup menu commands
###############################################################################
proc popupMenu {command args} {
    debug-info "popupMenu ($command $args)"
    global g
    global w

    switch -- $command {
    center {
            center
        }
    edit {
            do-edit
        }
    find {
            do-find
        }
    first {
            move first
        }
    last {
            move last
        }
    next {
            move 1
        }
    previous {
            move -1
        }
    nearest {
            moveNearest $g(activeWindow) xy [winfo pointerx $g(activeWindow)] \
              [winfo pointery $g(activeWindow)]
        }
    }
}

# Resize the text windows relative to each other.  The 8.4 method works
# much better.
proc pane_drag {win x} {
    global w
    global finfo
    global tk_version

    set relX [expr $x - [winfo rootx $win]]
    set maxX [winfo width $win]
    set frac [expr int((double($relX) / $maxX) * 100)]
    if {$tk_version < 8.4} {
      if {$frac < 15} { set frac 15 }
      if {$frac > 85} { set frac 85 }
      #debug-info "frac $frac"
      set L $frac
      set R [expr 100 - $frac]
      .client.leftlabel configure -width [expr $L * 2]
      .client.rightlabel configure -width [expr $R * 2]
    } else {
      if {$frac < 5} { set frac 5 }
      if {$frac > 95} { set frac 95 }
      #debug-info "frac $frac"
      set L $frac
      set R [expr 100 - $frac]
      grid columnconfigure $win 0 -weight $L
      grid columnconfigure $win 2 -weight $R
    }
    #debug-info " new: $L $R"
}

###############################################################################
# build the main client display (the text widgets, scrollbars, that
# sort of fluff)
###############################################################################
proc build-client {} {
    debug-info "build-client"
    global g
    global w
    global opts
    global map
    global tk_version

    frame $w(client) -bd 2 -relief flat

    # set up global variables to reference the widgets, so
    # we don't have to use hardcoded widget paths elsewhere
    # in the code
    #
    # Text  - holds the text of the file
    # Info  - sort-of "invisible" text widget which is kept in sync
    #              with the text widget and holds line numbers
    # CB    - contains changebars or status or something like that...
    # VSB   - vertical scrollbar
    # HSB   - horizontal scrollbar
    # Label - label to hold the name of the file
    set w(LeftText) $w(client).left.text
    set w(LeftInfo) $w(client).left.info
    set w(LeftCB) $w(client).left.changeBars
    set w(LeftVSB) $w(client).left.vsb
    set w(LeftHSB) $w(client).left.hsb
    set w(LeftLabel) $w(client).leftlabel

    set w(RightText) $w(client).right.text
    set w(RightInfo) $w(client).right.info
    set w(RightCB) $w(client).right.changeBars
    set w(RightVSB) $w(client).right.vsb
    set w(RightHSB) $w(client).right.hsb
    set w(RightLabel) $w(client).rightlabel

    set w(BottomText) $w(client).bottomtext

    set w(map) $w(client).map
    set w(mapCanvas) $w(map).canvas

    # these don't need to be global...
    set leftFrame $w(client).left
    set rightFrame $w(client).right

    # we'll create each widget twice; once for the left side
    # and once for the right.
    debug-info "  Assigning labels to headers"
    scan $opts(geometry) "%dx%d" width height
    label $w(LeftLabel) -bd 1 -relief flat -textvariable finfo(lbl,1) -width $width
    label $w(RightLabel) -bd 1 -relief flat -textvariable finfo(lbl,2) -width $width

    # this holds the text widgets and the scrollbars. The reason
    # for the frame is purely for aesthetics. It just looks
    # nicer, IMHO, to "embed" the scrollbars within the text
    # widget
    frame $leftFrame -bd 1 -relief sunken

    frame $rightFrame -bd 1 -relief sunken

    scrollbar $w(LeftHSB) -borderwidth 1 -orient horizontal -command \