diff.tcl

This Source-Navigator, an IDE for C/C++/Fortran/Java/Tcl/PHP/Python and a host of other languages.

# Copyright (c) 2000, 2001, Red Hat, Inc.
# 
# This file is part of Source-Navigator.
# 
# Source-Navigator 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, or (at your option)
# any later version.
# 
# Source-Navigator 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 Source-Navigator; see the file COPYING.  If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.
# 
# diff.tcl - Implement a UI on top of the familiar diff(1) tool.
# Copyright (C) 1998-1999 Cygnus Solutions.

itcl::class RCSTopdiff& {
    inherit sourcenav::Window

    protected variable opts
    protected variable g
    protected variable fo
    protected variable fog
    protected variable fn

    constructor {filo filn cfiln tl opt} {
        global sn_options
        global ${this}.currdiff

        set g(cfilo) ""
        set g(cfiln) ""
        set ${this}.currdiff ""
        set g(destroy) ""

        set g(filo) ${filo}
        set g(filn) ${filn}
        set g(cfilo) ${filo}
        set g(cfiln) ${cfiln}

        regsub -all "\[\t \]+" ${opt} " " opt
        set opts(diffopt) [string trim ${opt}]
        if {[string first "color" [winfo screenvisual .]] != -1} {
            set opts(currtag) {-background white -foreground red}
            set opts(difftag) {-background white -foreground blue}
        } else {
            set opts(currtag) {-background black -foreground white}
            set opts(difftag) {-background white -foreground black}
        }
        set opts(expfilo) 1
        set opts(expfiln) 1
        set opts(cmplimt) 100

        global sn_path

        ######################################################################
        # Set up the display...
        ######################################################################
        ${this} configure -title ${tl}

        # Pack the bottom-row buttons (inside .b).
        frame $itk_component(hull).b
        pack $itk_component(hull).b -side bottom -fill x -ipady 2 -ipadx 2

        # Pack the frame that holds the text widgets and scrollbars (.f).

        PanedWindow $itk_component(hull).f -width 900 -height 600 -fraction .5\
          -orientation x -min 0
        pack $itk_component(hull).f -fill both -expand y

        set fog [lindex [$itk_component(hull).f panes] 0]
        set fn [lindex [$itk_component(hull).f panes] 1]

        set fo ${fog}.file
        frame ${fo}

        # Pack the "old" widgets (fo).

        label ${fo}.name -relief groove -bd 2 -text $g(cfilo)
        pack ${fo}.name -side top -fill x

        # Pack the "new" widgets (fn).

        label ${fn}.name -relief groove -bd 2 -text $g(cfiln)
        pack ${fn}.name -side top -fill x

        scrollbar ${fo}.scr -command " ${fo}.text yview "
        scrollbar ${fo}.xscr -command " ${fo}.text xview " -orient horizontal

        text ${fo}.text -yscroll "${this} scrolls-set" -xscroll\
          "${fo}.xscr set" -width 80 -height 40 -wrap none\
          -font $sn_options(def,default-font)

        #xxx
        # Pack the text widgets and the scrollbars.
        pack ${fo}.xscr -side bottom -fill x
        pack ${fo}.scr -side left -fill y
        pack ${fo}.text -side top -fill both -expand y

        scrollbar ${fn}.scr -command " ${fn}.text yview "
        scrollbar ${fn}.xscr -command " ${fn}.text xview " -orient horizontal

        text ${fn}.text -yscroll "${fn}.scr set" -xscroll "${fn}.xscr set"\
          -width 80 -height 40 -wrap none

        # Pack the text widgets and the scrollbars.
        pack ${fn}.xscr -side bottom -fill x
        pack ${fn}.scr -side right -fill y
        pack ${fn}.text -side top -fill both -expand y

        # Pack the meta-scrollbar (.f.scr).

        scrollbar ${fog}.scr -command " ${this} texts-yview "

        pack ${fog}.scr -side right -fill y
        pack ${fo} -side right -fill both -expand y

        # Pack the quit, help, swap and rediff buttons.

        set str [get_indep String Close]
        set len [expr [string length ${str}] + 1]
        button $itk_component(hull).b.quit -text ${str} -command " ${this} quit "\
          -width ${len}
        pack $itk_component(hull).b.quit -side left -fill x -padx 4

        # Pack the next and prev buttons.

        set str [get_indep String Prev]
        set len [expr [string length ${str}] + 1]
        button $itk_component(hull).b.prev -text ${str} -command " ${this} move -1 "\
          -width ${len}
        pack $itk_component(hull).b.prev -side left -fill x -padx 4

        set str [get_indep String Next]
        set len [expr [string length ${str}] + 1]
        button $itk_component(hull).b.next -text ${str} -command " ${this} move 1 "\
          -width ${len}
        pack $itk_component(hull).b.next -side left -fill x -padx 4

        frame $itk_component(hull).b.pos -relief raised
        pack $itk_component(hull).b.pos -side left -padx 4 -ipady 1 -ipadx 1

        menubutton $itk_component(hull).b.pos.menubutton\
          -menu $itk_component(hull).b.pos.menubutton.menu -width 5\
          -textvariable $itk_component(hull).pos -relief raised
        pack $itk_component(hull).b.pos.menubutton -side left

        switch $sn_options(def,desktop-font-size) {
            24 {
                    set fnt 18
                }
            18 {
                    set fnt 14
                }
            14 {
                    set fnt 12
                }
            12 {
                    set fnt 10
                }
            default {
                    set fnt 8
                }
        }

        menu $itk_component(hull).b.pos.menubutton.menu

        label $itk_component(hull).b.pos.nlabel -text [get_indep String Of] -relief flat
        pack $itk_component(hull).b.pos.nlabel -side left

        label $itk_component(hull).b.pos.num -textvariable ${this}.count
        pack $itk_component(hull).b.pos.num -side left

        label $itk_component(hull).b.pos.curr -textvariable ${this}.currdiff -width 30\
          -relief groove
        pack $itk_component(hull).b.pos.curr -side left

        # Give the window a name & allow it to be resized.

        ${this} on_close "$itk_component(hull).b.quit invoke"
        ${this} configure -iconbitmap @$sn_path(bitmapdir)/paf.xbm
        ${this} configure -iconname DIFF

        # 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.

        eval "${fo}.text tag configure curr $opts(currtag)"
        eval "${fn}.text tag configure curr $opts(currtag)"
        eval "${fo}.text tag configure diff $opts(difftag)"
        eval "${fn}.text tag configure diff $opts(difftag)"

        ${this} rediff

        bind ${fo}.text <Double-1> " [info class]::edit_line %W $g(cfilo) "

        ${fo}.text tag raise sel
        ${fn}.text tag raise sel
    }

    proc edit_line {w file} {
        set pos [${w} index "insert linestart"]
        ${w} tag add sel "insert linestart" "insert lineend + 1c"
        selection own ${w} " "
        update idletasks
        sn_edit_file "" ${file} ${pos}
    }

    ###############################################################################
    # Throw up a modal error dialog.
    ###############################################################################

    proc do-error msg {
        sn_error_dialog ${msg}
    }

    ###############################################################################
    # Read (while untabifying) the text in the file "fn" into the variable\
      "var".
    ###############################################################################

    method quit {} {
        itcl::delete object ${this}
    }

    proc untabify {var fn} {
        upvar ${var} v
        global sn_options

        set fd [open ${fn} "r"]
        fconfigure ${fd} -encoding $sn_options(def,encoding) -blocking 0
        set v [read -nonewline ${fd}]
        close ${fd}

        #		set v [exec expand $fn]
    }
    ###############################################################################
    # Scroll all windows.  Credit to Wayne Throop...
    ###############################################################################

    method texts-yview args {
        global ${this}.count
        eval ${fo}.text yview ${args}
        eval ${fn}.text yview ${args}
    }

    ###############################################################################
    # Set all scrollbars.  Credit to Wayne Throop...
    ###############################################################################

    method scrolls-set {a1 a2} {
        catch {
            ${fo}.scr set ${a1} ${a2}
            ${fn}.scr set ${a1} ${a2}
            ${fog}.scr set ${a1} ${a2}
        }
    }

    ###############################################################################
    # Extract the start and end lines for file1 and file2 from the diff
    # stored in "line".
    ###############################################################################

    proc extract line {
        if [regexp {^([0-9]+)(a|c|d)} ${line} d digit action] {
            set s1 ${digit}
            set e1 ${digit}
        }\
        elseif [regexp {^([0-9]+),([0-9]+)(a|c|d)} ${line} d start end action] {
            set s1 ${start}
            set e1 ${end}
        }

        if [regexp {(a|c|d)([0-9]+)$} ${line} d action digit] {
            set s2 ${digit}
            set e2 ${digit}
        }\
        elseif [regexp {(a|c|d)([0-9]+),([0-9]+)$} ${line} d action start end] {
            set s2 ${start}
            set e2 ${end}
        }

        return "${line} ${s1} ${e1} ${s2} ${e2} ${action}"
    }

    ###############################################################################
    # Add a tag to a region.
    ###############################################################################

    proc add-tag {wgt tag start end type new} {
        if {${type} == "c" ||(${type} == "a" && ${new}) ||(${type} == "d" &&\
          !${new})} {
            ${wgt} tag add ${tag} ${start}.0 [expr ${end} + 1].0
        } else {
            for {set idx ${start}} {${idx} <= ${end}} {incr idx} {
                ${wgt} tag add ${tag} ${idx}.0 ${idx}.6

            }
        }
    }

    ###############################################################################
    # Move the "current" diff indicator (i.e. go to the next or previous diff
    # region if "relative" is 1; go to an absolute diff number if "relative"
    # is 0).
    ###############################################################################

    method move {value {relative 1} {setpos 1}} {
        global ${this}.currdiff
        upvar #0 ${this}.pos pos

        scan $g(pdiff,${pos}) "%s %d %d %d %d %s" dummy s1 e1 s2 e2 dt

        # Replace the 'diff' tag (and remove the 'curr' tag) on the current
        # 'current' region.

        ${fo}.text tag remove curr ${s1}.0 [expr ${e1} + 1].0
        ${fn}.text tag remove curr ${s2}.0 [expr ${e2} + 1].0

        add-tag ${fo}.text diff ${s1} ${e1} ${dt} 0
        add-tag ${fn}.text diff ${s2} ${e2} ${dt} 1

        # Bump 'pos' (one way or the other).

        if {${relative}} {
            set pos [expr ${pos} + ${value}]
        } else {
            set pos ${value}
        }

        # Range check 'pos'.

        if {${pos} > [llength $g(diff)]} {
            set pos [llength $g(diff)]
        }
        if {${pos} < 1} {
            set pos 1
        }

        # Figure out which lines we need to address...

        scan $g(pdiff,${pos}) "%s %d %d %d %d %s" currdiff s1 e1 s2 e2 dt
        set ${this}.currdiff ${currdiff}
        # Remove the 'diff' tag and add the 'curr' tag to the new 'current'
        # diff region.