Eskil

Diff
Login
Annotate Patch Side-by-side Diff

Differences From Artifact [8a0098d05f]:

To Artifact [309c3f5701]:

︙
35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
50
51
52
53
54
55

56
57
58
59

60
61
62
63





64
65
66




























































67
68

69
70

71
72
73
74
75




76
77
78
79
80
81
82

35
36
37
38
39
40
41

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133

134
135

136
137




138
139
140
141
142
143
144
145
146
147
148








-
+













+

-


+




+
+
+
+
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
+

-
-
-
-
+
+
+
+








# Stop Tk from meddling with the command line by copying it first.
set ::eskil(argv) $::argv
set ::eskil(argc) $::argc
set ::argv {}
set ::argc 0

set debug 0
set diffver "Version 2.3+ 2008-01-13"
set diffver "Version 2.3+ 2008-01-18"
set ::thisScript [file join [pwd] [info script]]

# Do initalisations for needed packages and globals.
# This is not run until needed to speed up command line error reporting.
proc Init {} {
    package require Tk 8.4
    catch {package require textSearch}
    if {[catch {package require Ttk}]} {
        if {[catch {package require tile}]} {
            puts "Themed Tk not found"
            exit
        }
    }
    # Reportedly, the ttk scrollbar looks bad on Aqua
    if {[tk windowingsystem] ne "aqua"} {
        #namespace import -force ttk::scrollbar
        interp alias {} scrollbar {} ttk::scrollbar
    }
    # Provide a ttk-friendly toplevel, fixing background and menubar
    if {[info commands ttk::toplevel] eq ""} {
        proc ttk::toplevel {w args} {
            eval [linsert $args 0 tk::toplevel $w]
            place [ttk::frame $w.tilebg] -x 0 -y 0 -relwidth 1 -relheight 1
            # Menubar looks out of place on linux. This adjusts the background
            # Which is enough to make it reasonable.
            set bg [ttk::style configure . -background]
            option add *Menubutton.background $bg
            option add *Menu.background $bg
            return $w
        }
    }
    ::snit::widgetadaptor entry {
        delegate method * to hull
        delegate option * to hull

        constructor {args} {
            installhull using ttk::entry
            $self configurelist $args
            # Make sure textvariable is initialised
            set varName [from args -textvariable ""]
            if {$varName ne ""} {
                upvar \#0 $varName var
                if {![info exists var]} {
                    set var ""
                }
            }
        }
        # Circumvent a bug in ttk::entry that "xview end" does not work.
        method xview {args} {
            if {[llength $args] == 1} {
                set ix [lindex $args 0]
                $hull xview [$hull index $ix]
            } else {
                eval $hull xview $args
            }
        }
    }

    ::snit::widgetadaptor frame {
        delegate method * to hull
        # Fix since stuff that use -bd must work (like bgerror)
        delegate option -bd to hull as -borderwidth
        # Translate padding options, assuming x and y is always equal.
        delegate option -padx to hull as -padding
        delegate option -pady to hull as -padding
        delegate option * to hull

        constructor {args} {
            set cl [from args -class ""]
            if {$cl ne ""} {
                set hullargs [list -class $cl]
            } else {
                set hullargs {}
            }
            eval installhull using ttk::frame $hullargs
            $self configurelist $args
        }
    }
    ::snit::widgetadaptor labelframe {
        delegate method * to hull
        delegate option -bd to hull as -borderwidth
        delegate option -padx to hull as -padding
        delegate option -pady to hull as -padding
        delegate option * to hull

        constructor {args} {
            installhull using ttk::labelframe
            $self configurelist $args
        }
    }

    #interp alias {} frame {} ttk::frame
    #interp alias {} toplevel {} ttk::toplevel
    interp alias {} toplevel {} ttk::toplevel
    #interp alias {} labelframe {} ttk::labelframe
    #interp alias {} label {} ttk::label
    interp alias {} label {} ttk::label
    #interp alias {} entry {} ttk::entry ;# need to support xview end
    #interp alias {} radiobutton {} ttk::radiobutton
    #interp alias {} menubutton {} ttk::menubutton
    #interp alias {} checkbutton {} ttk::checkbutton
    #interp alias {} button {} ttk::button
    interp alias {} radiobutton {} ttk::radiobutton
    #interp alias {} menubutton {} ttk::menubutton ;# Enough with bg set
    interp alias {} checkbutton {} ttk::checkbutton
    interp alias {} button {} ttk::button

    package require wcb

    if {[catch {package require psballoon}]} {
        # Add a dummy if it does not exist.
        proc addBalloon {args} {}
    } else {
︙
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340

2341
2342
2343
2344
2345

2346
2347
2348
2349
2350
2351
2352

2394
2395
2396
2397
2398
2399
2400






2401


2402
2403

2404
2405
2406
2407
2408
2409
2410
2411








-
-
-
-
-
-
+
-
-


-
+








}

# Emulate a label that:
# 1 : Displays the right part of the text if there isn't enough room
# 2 : Justfify text to the left if there is enough room.
# 3 : Does not try to allocate space according to its contents
proc fileLabel {w args} {
    eval tk::label $w $args
    set fg [$w cget -foreground]
    set bg [$w cget -background]
    set font [$w cget -font]
    destroy $w

    entry $w -style TLabel
    entry $w -relief flat -bd 0 -highlightthickness 0 \
            -foreground $fg -background $bg -font $font
    eval $w configure $args

    $w configure -takefocus 0 -state readonly -readonlybackground $bg
    $w configure -takefocus 0 -state readonly ;#-readonlybackground $bg

    set i [lsearch $args -textvariable]
    if {$i >= 0} {
	set var [lindex $args [expr {$i + 1}]]
	uplevel \#0 "trace variable $var w \
		{after idle {$w xview end} ;#}"
    }
︙
2611
2612
2613
2614
2615
2616
2617
2618

2619
2620
2621

2622
2623
2624


2625
2626

2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645

2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662

2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680

2681

2682
2683
2684
2685
2686
2687
2688

2670
2671
2672
2673
2674
2675
2676

2677
2678
2679

2680
2681


2682
2683
2684

2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703

2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720

2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740

2741
2742
2743
2744
2745
2746
2747
2748








-
+


-
+

-
-
+
+

-
+


















-
+
















-
+


















+
-
+








    addBalloon $top.lr1 "Revision number for CVS/RCS/ClearCase diff."
    entry $top.er1 -width 12 -textvariable diff($top,doptrev1)
    set ::widgets($top,rev1) $top.er1
    label $top.lr2 -text "Rev 2"
    addBalloon $top.lr2 "Revision number for CVS/RCS/ClearCase diff."
    entry $top.er2 -width 12 -textvariable diff($top,doptrev2)
    set ::widgets($top,rev2) $top.er2
    button $top.bcm -text Commit -padx 15 -command [list revCommit $top] \
    button $top.bcm -text Commit -command [list revCommit $top] \
            -state disabled -underline 0
    set ::widgets($top,commit) $top.bcm
    button $top.bfp -text "Prev Diff" -relief raised \
    button $top.bfp -text "Prev Diff" \
            -command [list findDiff $top -1] \
            -underline 0 -padx 15
    button $top.bfn -text "Next Diff" -relief raised \
            -underline 0
    button $top.bfn -text "Next Diff" \
            -command [list findDiff $top 1] \
            -underline 0 -padx 15
            -underline 0
    bind $top <Alt-n> [list findDiff $top 1]
    bind $top <Alt-p> [list findDiff $top -1]
    bind $top <Alt-c> [list revCommit $top]

    catch {font delete myfont}
    font create myfont -family $Pref(fontfamily) -size $Pref(fontsize)

    fileLabel $top.l1 -textvariable diff($top,leftLabel)
    fileLabel $top.l2 -textvariable diff($top,rightLabel)

    frame $top.ft1 -borderwidth 2 -relief sunken
    text $top.ft1.tl -height $Pref(lines) -width 5 -wrap none \
            -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
            -takefocus 0
    text $top.ft1.tt -height $Pref(lines) -width $Pref(linewidth) -wrap none \
            -xscrollcommand [list $top.sbx1 set] \
            -font myfont -borderwidth 0 -padx 1 \
            -highlightthickness 0
    frame $top.ft1.f -width 2 -height 2 -bg lightgray
    tk::frame $top.ft1.f -width 2 -height 2 -bg lightgray
    pack $top.ft1.tl -side left -fill y
    pack $top.ft1.f -side left -fill y
    pack $top.ft1.tt -side right -fill both -expand 1
    scrollbar $top.sby -orient vertical
    scrollbar $top.sbx1 -orient horizontal -command [list $top.ft1.tt xview]
    set ::widgets($top,wLine1) $top.ft1.tl
    set ::widgets($top,wDiff1) $top.ft1.tt

    frame $top.ft2 -borderwidth 2 -relief sunken
    text $top.ft2.tl -height $Pref(lines) -width 5 -wrap none \
            -font myfont -borderwidth 0 -padx 0 -highlightthickness 0 \
            -takefocus 0
    text $top.ft2.tt -height $Pref(lines) -width $Pref(linewidth) -wrap none \
            -xscrollcommand [list $top.sbx2 set] \
            -font myfont -borderwidth 0 -padx 1 \
            -highlightthickness 0
    frame $top.ft2.f -width 2 -height 2 -bg lightgray
    tk::frame $top.ft2.f -width 2 -height 2 -bg lightgray
    pack $top.ft2.tl -side left -fill y
    pack $top.ft2.f -side left -fill y
    pack $top.ft2.tt -side right -fill both -expand 1
    scrollbar $top.sbx2 -orient horizontal -command [list $top.ft2.tt xview]
    set ::widgets($top,wLine2) $top.ft2.tl
    set ::widgets($top,wDiff2) $top.ft2.tt
    commonYScroll $top.sby $top.ft1.tl $top.ft1.tt $top.ft2.tl $top.ft2.tt

    # Set up a tag for incremental search bindings
    if {[info procs textSearch::enableSearch] != ""} {
        textSearch::enableSearch $top.ft1.tt -label ::widgets($top,isearchLabel)
        textSearch::enableSearch $top.ft2.tt -label ::widgets($top,isearchLabel)
    }

    label $top.le -textvariable ::widgets($top,eqLabel) -width 1
    addBalloon $top.le "* means external diff is running.\n= means files do\
            not differ.\n! means a large block is being processed.\nBlank\
            means files differ."
    # FIXA: verify that this label is ok after Tile migration
    label $top.ls -width 1 -pady 0 -padx 0 \
    label $top.ls -width 1 \
            -textvariable ::widgets($top,isearchLabel)
    addBalloon $top.ls "Incremental search indicator"
    set map [createMap $top]

    applyColor
    foreach w [list $top.ft1.tt $top.ft2.tt] {
        # The last change in a row is underlined
︙
2715
2716
2717
2718
2719
2720
2721


2722
2723
2724
2725
2726
2727
2728

2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790








+
+








    if {$debug == 0} {
        bind $top <Key> "backDoor %A"
    }

    pack $top.bfn -in $top.f -side right -padx {3 6}
    pack $top.bfp $top.bcm $top.er2 $top.lr2 $top.er1 $top.lr1 \
            -in $top.f -side right -padx 3
    pack $top.bfn $top.bfp $top.bcm -ipadx 15

    if {$debug == 1} {
        $top.m add cascade -label "Debug" -menu $top.m.md -underline 0
        menu $top.m.md
        if {$tcl_platform(platform) eq "windows"} {
            $top.m.md add checkbutton -label "Console" -variable consolestate \
                    -onvalue show -offvalue hide \
                    -command {console $consolestate}
︙
3042
3043
3044
3045
3046
3047
3048
3049

3050
3051
3052
3053
3054
3055
3056

3104
3105
3106
3107
3108
3109
3110

3111
3112
3113
3114
3115
3116
3117
3118








-
+








        raise $w
        focus $w
    } else {
        toplevel $w -padx 3 -pady 3
        wm title $w "Preferences: Preprocess"
    }

    button $w.b -text "Add" -padx 15 -command [list AddPrefRegsub $top $w]
    button $w.b -text "Add" -command [list AddPrefRegsub $top $w]

    # Result example part
    if {![info exists ::diff($top,prefregexa)]} {
        set ::diff($top,prefregexa) \
                "An example TextString FOR_REGSUB /* Comment */"
        set ::diff($top,prefregexa2) \
                "An example TextString FOR_REGSUB /* Comment */"
︙
3080
3081
3082
3083
3084
3085
3086
3087

3088
3089
3090
3091
3092
3093
3094

3142
3143
3144
3145
3146
3147
3148

3149
3150
3151
3152
3153
3154
3155
3156








-
+








    set ::widgets($top,prefRegsubOk) $w.fb.b1

    grid $w.fb.b1 x $w.fb.b2 -sticky we
    grid columnconfigure $w.fb {0 2} -uniform a
    grid columnconfigure $w.fb 1 -weight 1

    # Top layout
    pack $w.b -side "top" -anchor "w" -padx 3 -pady 3
    pack $w.b -side "top" -anchor "w" -padx 3 -pady 3 -ipadx 15
    pack $w.fb $w.res -side bottom -fill x -padx 3 -pady 3

    # Fill in existing or an empty line
    if {[llength $::Pref(regsub)] == 0} {
        AddPrefRegsub $top $w
    } else {
        set t 1
︙