Eskil

Check-in [893dd218dc]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added map. Improved yscroll.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 893dd218dca4d3064c68533d4df1b9ea8fb24a7e
User & Date: spjutp 1998-08-12 09:22:38.000
Context
1998-08-14
07:17
Optimizations with foreach check-in: 703198ac34 user: spjutp tags: trunk
1998-08-12
09:22
Added map. Improved yscroll. check-in: 893dd218dc user: spjutp tags: trunk
1998-08-07
14:16
Minor fixes. Release 1.1 check-in: 2dd54f03f5 user: spjutp tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to src/eskil.tcl.
︙︙
36
37
38
39
40
41
42


43
44
45
46
47
48
49


50
51
52
53
54
55
56

#
#   Revised   By       Date     Remark
#
#     1.0     DC-PS    980612   New Version.
#     1.1     DC-PS    980807   Parsing of change blocks added
#                               Options menu and variables changed
#                               Command line options added


#
#-----------------------------------------------
# the next line restarts using wish \
exec wish "$0" "$@"

set debug 0
set diffver "Version 1.1  980807"



proc myform {line text} {
    return [format "%3d: %s\n" $line $text]
}

proc myforml {line} {
    return [format "%3d: " $line]








>
>





|
|
>
>








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

#
#   Revised   By       Date     Remark
#
#     1.0     DC-PS    980612   New Version.
#     1.1     DC-PS    980807   Parsing of change blocks added
#                               Options menu and variables changed
#                               Command line options added
#     1.2     DC-PS    980812   Improved yscroll
#                               Added map next to y-scrollbar
#
#-----------------------------------------------
# the next line restarts using wish \
exec wish "$0" "$@"

set debug 1
set diffver "Version 1.2  beta"
set color(change) red
set color(new) blue

proc myform {line text} {
    return [format "%3d: %s\n" $line $text]
}

proc myforml {line} {
    return [format "%3d: " $line]
︙︙
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307

308
309
310
311
312
313
314
315
316
317
318

319
320
321
322
323
324
325
326
327
328
329
330



331
332
333
334
335
336
337

        .t2 insert end [myform $doingLine2 $line2] $tag2
    }
    incr doingLine1
    incr doingLine2
}

proc dotext {ch1data ch2 tag1 tag2 n1 n2 line1 line2} {
    global doingLine1 doingLine2 Pref

    if {$n1 == 0 && $n2 == 0} {
        while {[gets $ch2 apa] != -1} {
            .t2 insert end [myform $doingLine2 $apa]
            incr doingLine2
            .t1 insert end [myform $doingLine1 $apa]
            incr doingLine1

        }
        return
    }

    #Display all equal lines before next diff
    while {$doingLine1 < $line1} {
        gets $ch2 apa
        .t1 insert end [myform $doingLine1 $apa]
        incr doingLine1
        .t2 insert end [myform $doingLine2 $apa]
        incr doingLine2

    }
    if {$doingLine2 != $line2} {
        .t1 insert end "**Bad alignment here!! $doingLine2 $line2**\n"
        .t2 insert end "**Bad alignment here!! $doingLine2 $line2**\n"
    }

    if {$n1 == $n2} {
        for {set t 0} {$t < $n1} {incr t} {
            set line1 [lindex $ch1data $t]
            gets $ch2 line2
            insertMatchingLines $line1 $line2 $tag1 $tag2
        }



    } else {
        if {$n1 != 0 && $n2 != 0 && $Pref(parse) == "block"} {
            set block1 {}
            for {set t 0} {$t < $n1} {incr t} {
                set apa [lindex $ch1data $t]
                lappend block1 $apa
            }








|







>











>












>
>
>








297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346

        .t2 insert end [myform $doingLine2 $line2] $tag2
    }
    incr doingLine1
    incr doingLine2
}

proc dotext {ch1data ch2 tag1 tag2 n1 n2 line1 line2} {
    global doingLine1 doingLine2 Pref mapList mapMax

    if {$n1 == 0 && $n2 == 0} {
        while {[gets $ch2 apa] != -1} {
            .t2 insert end [myform $doingLine2 $apa]
            incr doingLine2
            .t1 insert end [myform $doingLine1 $apa]
            incr doingLine1
            incr mapMax
        }
        return
    }

    #Display all equal lines before next diff
    while {$doingLine1 < $line1} {
        gets $ch2 apa
        .t1 insert end [myform $doingLine1 $apa]
        incr doingLine1
        .t2 insert end [myform $doingLine2 $apa]
        incr doingLine2
        incr mapMax
    }
    if {$doingLine2 != $line2} {
        .t1 insert end "**Bad alignment here!! $doingLine2 $line2**\n"
        .t2 insert end "**Bad alignment here!! $doingLine2 $line2**\n"
    }

    if {$n1 == $n2} {
        for {set t 0} {$t < $n1} {incr t} {
            set line1 [lindex $ch1data $t]
            gets $ch2 line2
            insertMatchingLines $line1 $line2 $tag1 $tag2
        }
        lappend mapList $mapMax
        incr mapMax $n1
        lappend mapList $mapMax $tag1
    } else {
        if {$n1 != 0 && $n2 != 0 && $Pref(parse) == "block"} {
            set block1 {}
            for {set t 0} {$t < $n1} {incr t} {
                set apa [lindex $ch1data $t]
                lappend block1 $apa
            }
︙︙
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369



370
371
372
373
374
375
376
377
378
379
380
381
382
383
384



385
386
387
388



389
390
391
392
393
394
395

                    set line1 [lindex $block1 $t1]
                    set line2 [lindex $block2 $t2]
                    insertMatchingLines $line1 $line2 $tag1 $tag2
                    incr t1
                    incr t2
                }
                if {$c == "d"} {
                    set apa [lindex $block1 $t1]
                    .t1 insert end [myform $doingLine1 $apa] $tag1
                    .t2 insert end "\n"
                    incr doingLine1
                    incr t1
                }
                if {$c == "a"} {
                    set apa [lindex $block2 $t2]
                    .t2 insert end [myform $doingLine2 $apa] $tag2
                    .t1 insert end "\n"
                    incr doingLine2
                    incr t2
                }
            }



        } else {
            for {set t 0} {$t < $n1} {incr t} {
                set apa [lindex $ch1data $t]
                .t1 insert end [myform $doingLine1 $apa] $tag1
                incr doingLine1
            }
            for {set t 0} {$t < $n2} {incr t} {
                gets $ch2 apa
                .t2 insert end [myform $doingLine2 $apa] $tag2
                incr doingLine2
            }
            if {$n1 < $n2} {
                for {set t $n1} {$t < $n2} {incr t} {
                    .t1 insert end "\n"
                }



            } elseif {$n2 < $n1} {
                for {set t $n2} {$t < $n1} {incr t} {
                    .t2 insert end "\n"
                }



            }
        }
    }
}

#Scroll windows to next diff
proc findNext {} {








|
|





|
|





>
>
>















>
>
>




>
>
>








358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413

                    set line1 [lindex $block1 $t1]
                    set line2 [lindex $block2 $t2]
                    insertMatchingLines $line1 $line2 $tag1 $tag2
                    incr t1
                    incr t2
                }
                if {$c == "d"} {
                    set bepa [lindex $block1 $t1]
                    .t1 insert end [myform $doingLine1 $bepa] $tag1
                    .t2 insert end "\n"
                    incr doingLine1
                    incr t1
                }
                if {$c == "a"} {
                    set bepa [lindex $block2 $t2]
                    .t2 insert end [myform $doingLine2 $bepa] $tag2
                    .t1 insert end "\n"
                    incr doingLine2
                    incr t2
                }
            }
            lappend mapList $mapMax
            incr mapMax [llength $apa]
            lappend mapList $mapMax $tag1
        } else {
            for {set t 0} {$t < $n1} {incr t} {
                set apa [lindex $ch1data $t]
                .t1 insert end [myform $doingLine1 $apa] $tag1
                incr doingLine1
            }
            for {set t 0} {$t < $n2} {incr t} {
                gets $ch2 apa
                .t2 insert end [myform $doingLine2 $apa] $tag2
                incr doingLine2
            }
            if {$n1 < $n2} {
                for {set t $n1} {$t < $n2} {incr t} {
                    .t1 insert end "\n"
                }
                lappend mapList $mapMax
                incr mapMax $n2
                lappend mapList $mapMax $tag2
            } elseif {$n2 < $n1} {
                for {set t $n2} {$t < $n1} {incr t} {
                    .t2 insert end "\n"
                }
                lappend mapList $mapMax
                incr mapMax $n1
                lappend mapList $mapMax $tag1
            }
        }
    }
}

#Scroll windows to next diff
proc findNext {} {
︙︙
447
448
449
450
451
452
453

454
455
456
457
458
459
460
461
462
463
464
465


466
467
468
469
470
471
472
473
474

        puts "[expr {$tid2 - $tid1}]"
    }
}

proc doDiff {} {
    global leftFile rightFile leftOK rightOK RCS
    global eqLabel RCS Pref doingLine1 doingLine2


    if {$RCS == 0 && ($leftOK == 0 || $rightOK == 0)} {
        disableRedo
        return
    } else {
        enableRedo
    }

    busyCursor

    .t1 delete 1.0 end
    .t2 delete 1.0 end



    update idletasks

    if {$RCS} {
        set differr [catch {eval exec rcsdiff $Pref(dopt) $Pref(ignore) $rightFile} diffres]
    } else {
        set differr [catch {eval exec diff $Pref(dopt) $Pref(ignore) $leftFile $rightFile} diffres]
    }









>












>
>

|








465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495

        puts "[expr {$tid2 - $tid1}]"
    }
}

proc doDiff {} {
    global leftFile rightFile leftOK rightOK RCS
    global eqLabel RCS Pref doingLine1 doingLine2
    global mapList mapMax

    if {$RCS == 0 && ($leftOK == 0 || $rightOK == 0)} {
        disableRedo
        return
    } else {
        enableRedo
    }

    busyCursor

    .t1 delete 1.0 end
    .t2 delete 1.0 end
    set mapList {}
    set mapMax 0

    update

    if {$RCS} {
        set differr [catch {eval exec rcsdiff $Pref(dopt) $Pref(ignore) $rightFile} diffres]
    } else {
        set differr [catch {eval exec diff $Pref(dopt) $Pref(ignore) $leftFile $rightFile} diffres]
    }
︙︙
545
546
547
548
549
550
551

552
553
554
555
556
557
558

            }
        }
    }

    dotext "" $ch2 "" "" 0 0 0 0

    close $ch2

    normalCursor
    time2
}

proc doOpenLeft {} {
    global leftFile leftDir rightDir leftOK
    if {![info exists leftDir]} {








>








566
567
568
569
570
571
572
573
574
575
576
577
578
579
580

            }
        }
    }

    dotext "" $ch2 "" "" 0 0 0 0

    close $ch2
    drawMap -1
    normalCursor
    time2
}

proc doOpenLeft {} {
    global leftFile leftDir rightDir leftOK
    if {![info exists leftDir]} {
︙︙
622
623
624
625
626
627
628





















629
630
631
632
633





634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655

    if {[doOpenLeft]} {
        if {[doOpenRight]} {
            set RCS 0
            doDiff
        }
    }
}






















proc my_yview args {
    eval .t1 yview $args
    eval .t2 yview $args
}






proc chFont {} {
    global Pref

    font configure myfont -size $Pref(fontsize)
#    .t1 configure -font "Courier $Pref(fontsize)"
#    .t2 configure -font "Courier $Pref(fontsize)"
}

proc makeDiffWin {} {
    global Pref tcl_platform debug
    eval destroy [winfo children .]

    frame .f
    grid .f - - -row 0 -sticky news

    menubutton .mf -text File -underline 0 -menu .mf.m
    menu .mf.m
    .mf.m add command -label "Redo Diff" -underline 5 -command doDiff -state disabled
    .mf.m add separator
    .mf.m add command -label "Open Both" -underline 0 -command openBoth
    .mf.m add command -label "Open Left File" -command openLeft








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





>
>
>
>
>










|



|








644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703

    if {[doOpenLeft]} {
        if {[doOpenRight]} {
            set RCS 0
            doDiff
        }
    }
}

proc drawMap {newh} {
    global mapList mapMax color
 
    set oldh [map cget -height]
    if {$oldh == $newh} return
 
    map blank
    if {![info exists mapList] || $mapList == ""} return

    set w [winfo width .c]
    set h [winfo height .c]
    set x2 [expr {$w - 1}]
    map configure -width $w -height $h
 
    foreach {start stop type} $mapList {
        set y1 [expr {$start * $h / $mapMax}]
        set y2 [expr {$stop * $h / $mapMax + 1}]
        map put $color($type) -to 1 $y1 $x2 $y2
    }
}

proc my_yview args {
    eval .t1 yview $args
    eval .t2 yview $args
}

proc my_yscroll args {
    eval .sby set $args
    my_yview moveto [lindex $args 0]
}

proc chFont {} {
    global Pref

    font configure myfont -size $Pref(fontsize)
#    .t1 configure -font "Courier $Pref(fontsize)"
#    .t2 configure -font "Courier $Pref(fontsize)"
}

proc makeDiffWin {} {
    global Pref tcl_platform debug color
    eval destroy [winfo children .]

    frame .f
    grid .f - - - -row 0 -sticky news

    menubutton .mf -text File -underline 0 -menu .mf.m
    menu .mf.m
    .mf.m add command -label "Redo Diff" -underline 5 -command doDiff -state disabled
    .mf.m add separator
    .mf.m add command -label "Open Both" -underline 0 -command openBoth
    .mf.m add command -label "Open Left File" -command openLeft
︙︙
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712

713
714
715
716
717
718
719
720
721
722
723





724
725
726
727
728
729
730

    label .lo -text "Diff Options"

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

    label .l1 -textvariable leftFile -anchor e -width 10
    label .l2 -textvariable rightFile -anchor e -width 10
    text .t1 -height 40 -width 60 -wrap none -yscrollcommand ".sby set" \
	    -xscrollcommand ".sbx1 set" -font myfont
    scrollbar .sby -orient vertical -command "my_yview"
    scrollbar .sbx1 -orient horizontal -command ".t1 xview"
    text .t2 -height 40 -width 60 -wrap none \
	    -xscrollcommand ".sbx2 set" -font myfont
    scrollbar .sbx2 -orient horizontal -command ".t2 xview"
    label .le -textvariable eqLabel -width 1


    .t1 tag configure new -foreground blue -background gray 
    .t1 tag configure change -foreground red -background gray
    .t2 tag configure new -foreground blue -background gray
    .t2 tag configure change -foreground red -background gray
    
    grid .l1 .le .l2 -row 1 -sticky news
    grid .t1 .sby .t2 -row 2 -sticky news
    grid .sbx1 x .sbx2 -row 3 -sticky news
    grid columnconfigure . {0 2} -weight 1
    grid rowconfigure . 2 -weight 1






    if {$debug == 1} {
        menubutton .md -text Debug -menu .md.m -relief ridge
        menu .md.m
        .md.m add checkbutton -label Console -variable consolestate \
                -onvalue show -offvalue hide -command {console $consolestate}
        .md.m add separator








|



|



>

|
|
|
|

|
|
|
|

>
>
>
>
>








746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784

    label .lo -text "Diff Options"

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

    label .l1 -textvariable leftFile -anchor e -width 10
    label .l2 -textvariable rightFile -anchor e -width 10
    text .t1 -height 40 -width 60 -wrap none -yscrollcommand my_yscroll \
	    -xscrollcommand ".sbx1 set" -font myfont
    scrollbar .sby -orient vertical -command "my_yview"
    scrollbar .sbx1 -orient horizontal -command ".t1 xview"
    text .t2 -height 40 -width 60 -wrap none -yscrollcommand my_yscroll \
	    -xscrollcommand ".sbx2 set" -font myfont
    scrollbar .sbx2 -orient horizontal -command ".t2 xview"
    label .le -textvariable eqLabel -width 1
    canvas .c -width 4

    .t1 tag configure new -foreground $color(new) -background gray 
    .t1 tag configure change -foreground $color(change) -background gray
    .t2 tag configure new -foreground $color(new) -background gray
    .t2 tag configure change -foreground $color(change) -background gray
    
    grid .l1 .le - .l2 -row 1 -sticky news
    grid .t1 .c .sby .t2 -row 2 -sticky news
    grid .sbx1 x x .sbx2 -row 3 -sticky news
    grid columnconfigure . {0 3} -weight 1
    grid rowconfigure . 2 -weight 1
    grid .c -pady [expr {[.sby cget -width] + 2}]

    image create photo map
    .c create image 0 0 -anchor nw -image map
    bind .c <Configure> {drawMap %h}

    if {$debug == 1} {
        menubutton .md -text Debug -menu .md.m -relief ridge
        menu .md.m
        .md.m add checkbutton -label Console -variable consolestate \
                -onvalue show -offvalue hide -command {console $consolestate}
        .md.m add separator
︙︙
754
755
756
757
758
759
760

761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780

    .ab.t insert end "$diffver\n"
    .ab.t insert end "Made by Peter Spjuth\n"
    .ab.t insert end "E-Mail: peter.spjuth@space.se\n\n"

}

proc makeHelpWin {} {

    destroy .he

    toplevel .he
    wm title .he "Diff.tcl Help"
    text .he.t -width 80 -height 15 -wrap word -yscrollcommand ".he.sb set"\
            -font "Courier 8"
    scrollbar .he.sb -orient vert -command ".he.t yview"
    button .he.b -text "Close" -command "destroy .he"
    pack .he.b -side bottom
    pack .he.sb -side right -fill y
    pack .he.t -side left -expand y -fill both
    .he.t tag configure new -foreground blue -background gray 
    .he.t tag configure change -foreground red -background gray
    .he.t tag configure ul -underline 1

    .he.t insert end {\

} "" {Commands} ul {

File Menu








>











|
|








808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835

    .ab.t insert end "$diffver\n"
    .ab.t insert end "Made by Peter Spjuth\n"
    .ab.t insert end "E-Mail: peter.spjuth@space.se\n\n"

}

proc makeHelpWin {} {
    global color
    destroy .he

    toplevel .he
    wm title .he "Diff.tcl Help"
    text .he.t -width 80 -height 15 -wrap word -yscrollcommand ".he.sb set"\
            -font "Courier 8"
    scrollbar .he.sb -orient vert -command ".he.t yview"
    button .he.b -text "Close" -command "destroy .he"
    pack .he.b -side bottom
    pack .he.sb -side right -fill y
    pack .he.t -side left -expand y -fill both
    .he.t tag configure new -foreground $color(new) -background gray 
    .he.t tag configure change -foreground $color(change) -background gray
    .he.t tag configure ul -underline 1

    .he.t insert end {\

} "" {Commands} ul {

File Menu
︙︙