Fossil SCM

Add "Quit" and "Save As.." buttons to the "diff --tk" command.

drh 2014-02-27 16:21 trunk
Commit 29d80dd2f5d2c7afd33589481157b87740a80cc8
Parent a526d71968062df…
1 file changed +75 -43
~ src/diffcmd.c
M src/diffcmd.c
+75 -43
--- src/diffcmd.c
+++ src/diffcmd.c
@@ -598,12 +598,13 @@
598598
 }
599599
600600
 /* A Tcl/Tk script used to render diff output.
601601
 */
602602
 static const char zDiffScript[] =
603
+@ set prog {
603604
 @ package require Tk
604
-@
605
+@
605606
 @ array set CFG {
606607
 @ TITLE {Fossil Diff}
607608
 @ LN_COL_BG #dddddd
608609
 @ LN_COL_FG #444444
609610
 @ TXT_COL_BG #ffffff
@@ -622,69 +623,84 @@
622623
 @ PADX 5
623624
 @ WIDTH 80
624625
 @ HEIGHT 45
625626
 @ LB_HEIGHT 25
626627
 @ }
627
-@
628
+@
628629
 @ if {![namespace exists ttk]} {
629630
 @ interp alias {} ::ttk::scrollbar {} ::scrollbar
630631
 @ interp alias {} ::ttk::menubutton {} ::menubutton
631632
 @ }
632
-@
633
+@
633634
 @ proc dehtml {x} {
634635
 @ set x [regsub -all {<[^>]*>} $x {}]
635636
 @ return [string map {&amp; & &lt; < &gt; > &#39; ' &quot; \"} $x]
636637
 @ }
637
-@
638
+@
638639
 @ proc cols {} {
639640
 @ return [list .lnA .txtA .mkr .lnB .txtB]
640641
 @ }
641
-@
642
+@
642643
 @ proc colType {c} {
643644
 @ regexp {[a-z]+} $c type
644645
 @ return $type
645646
 @ }
646
-@
647
+@
648
+@ proc getLine {difftxt N iivar} {
649
+@ upvar $iivar ii
650
+@ if {$ii>=$N} {return -1}
651
+@ set x [lindex $difftxt $ii]
652
+@ incr ii
653
+@ return $x
654
+@ }
655
+@
647656
 @ proc readDiffs {fossilcmd} {
648
-@ set in [open $fossilcmd r]
649
-@ fconfigure $in -encoding utf-8
657
+@ global difftxt
658
+@ if {![info exists difftxt]} {
659
+@ set in [open $fossilcmd r]
660
+@ fconfigure $in -encoding utf-8
661
+@ set difftxt [split [read $in] \n]
662
+@ close $in
663
+@ }
664
+@ set N [llength $difftxt]
665
+@ set ii 0
650666
 @ set nDiffs 0
651667
 @ array set widths {txt 0 ln 0 mkr 0}
652
-@ while {[gets $in line] != -1} {
668
+@ while {[set line [getLine $difftxt $N ii]] != -1} {
653669
 @ if {![regexp {^=+\s+(.*?)\s+=+$} $line all fn]} {
654670
 @ continue
655671
 @ }
656
-@ if {[string compare -length 6 [gets $in] "<table"]} {
672
+@ if {[string compare -length 6 [getLine $difftxt $N ii] "<table"]} {
657673
 @ continue
658674
 @ }
659675
 @ incr nDiffs
660676
 @ set idx [expr {$nDiffs > 1 ? [.txtA index end] : "1.0"}]
661677
 @ .wfiles.lb insert end $fn
662
-@
678
+@
663679
 @ foreach c [cols] {
664
-@ while {[gets $in] ne "<pre>"} continue
665
-@
680
+@ while {[getLine $difftxt $N ii] ne "<pre>"} continue
681
+@
666682
 @ if {$nDiffs > 1} {
667683
 @ $c insert end \n -
668684
 @ }
669685
 @ if {[colType $c] eq "txt"} {
670686
 @ $c insert end $fn\n fn
671687
 @ } else {
672688
 @ $c insert end \n fn
673689
 @ }
674690
 @ $c insert end \n -
675
-@
691
+@
676692
 @ set type [colType $c]
677693
 @ set str {}
678
-@ while {[set line [gets $in]] ne "</pre>"} {
694
+@ while {[set line [getLine $difftxt $N ii]] ne "</pre>"} {
679695
 @ set len [string length [dehtml $line]]
680696
 @ if {$len > $widths($type)} {
681697
 @ set widths($type) $len
682698
 @ }
683699
 @ append str $line\n
684700
 @ }
685
-@
701
+@
686702
 @ set re {<span class="diff([a-z]+)">([^<]*)</span>}
687703
 @ # Use \r as separator since it can't appear in the diff output (it gets
688704
 @ # converted to a space).
689705
 @ set str [regsub -all $re $str "\r\\1\r\\2\r"]
690706
 @ foreach {pre class mid} [split $str \r] {
@@ -694,12 +710,11 @@
694710
 @ $c insert end [dehtml $pre] -
695711
 @ }
696712
 @ }
697713
 @ }
698714
 @ }
699
-@ close $in
700
-@
715
+@
701716
 @ foreach c [cols] {
702717
 @ set type [colType $c]
703718
 @ if {$type ne "txt"} {
704719
 @ $c config -width $widths($type)
705720
 @ }
@@ -707,19 +722,19 @@
707722
 @ }
708723
 @ if {$nDiffs <= [.wfiles.lb cget -height]} {
709724
 @ .wfiles.lb config -height $nDiffs
710725
 @ grid remove .wfiles.sb
711726
 @ }
712
-@
727
+@
713728
 @ return $nDiffs
714729
 @ }
715
-@
730
+@
716731
 @ proc viewDiff {idx} {
717732
 @ .txtA yview $idx
718733
 @ .txtA xview moveto 0
719734
 @ }
720
-@
735
+@
721736
 @ proc cycleDiffs {{reverse 0}} {
722737
 @ if {$reverse} {
723738
 @ set range [.txtA tag prevrange fn @0,0 1.0]
724739
 @ if {$range eq ""} {
725740
 @ viewDiff {fn.last -1c}
@@ -733,36 +748,36 @@
733748
 @ } else {
734749
 @ viewDiff [lindex $range 0]
735750
 @ }
736751
 @ }
737752
 @ }
738
-@
753
+@
739754
 @ proc xvis {col} {
740755
 @ set view [$col xview]
741756
 @ return [expr {[lindex $view 1]-[lindex $view 0]}]
742757
 @ }
743
-@
758
+@
744759
 @ proc scroll-x {args} {
745760
 @ set c .txt[expr {[xvis .txtA] < [xvis .txtB] ? "A" : "B"}]
746761
 @ eval $c xview $args
747762
 @ }
748
-@
763
+@
749764
 @ interp alias {} scroll-y {} .txtA yview
750
-@
765
+@
751766
 @ proc noop {args} {}
752
-@
767
+@
753768
 @ proc enableSync {axis} {
754769
 @ update idletasks
755770
 @ interp alias {} sync-$axis {}
756771
 @ rename _sync-$axis sync-$axis
757772
 @ }
758
-@
773
+@
759774
 @ proc disableSync {axis} {
760775
 @ rename sync-$axis _sync-$axis
761776
 @ interp alias {} sync-$axis {} noop
762777
 @ }
763
-@
778
+@
764779
 @ proc sync-x {col first last} {
765780
 @ disableSync x
766781
 @ $col xview moveto [expr {$first*[xvis $col]/($last-$first)}]
767782
 @ foreach side {A B} {
768783
 @ set sb .sbx$side
@@ -774,11 +789,11 @@
774789
 @ grid remove $sb
775790
 @ }
776791
 @ }
777792
 @ enableSync x
778793
 @ }
779
-@
794
+@
780795
 @ proc sync-y {first last} {
781796
 @ disableSync y
782797
 @ foreach c [cols] {
783798
 @ $c yview moveto $first
784799
 @ }
@@ -788,21 +803,21 @@
788803
 @ } else {
789804
 @ grid remove .sby
790805
 @ }
791806
 @ enableSync y
792807
 @ }
793
-@
808
+@
794809
 @ wm withdraw .
795810
 @ wm title . $CFG(TITLE)
796811
 @ wm iconname . $CFG(TITLE)
797812
 @ bind . <q> exit
798813
 @ bind . <Destroy> {after 0 exit}
799814
 @ bind . <Tab> {cycleDiffs; break}
800815
 @ bind . <<PrevWindow>> {cycleDiffs 1; break}
801816
 @ bind . <Return> {
802
-@ event generate .files <1>
803
-@ event generate .files <ButtonRelease-1>
817
+@ event generate .bb.files <1>
818
+@ event generate .bb.files <ButtonRelease-1>
804819
 @ break
805820
 @ }
806821
 @ foreach {key axis args} {
807822
 @ Up y {scroll -5 units}
808823
 @ Down y {scroll 5 units}
@@ -814,22 +829,23 @@
814829
 @ End y {moveto 1}
815830
 @ } {
816831
 @ bind . <$key> "scroll-$axis $args; break"
817832
 @ bind . <Shift-$key> continue
818833
 @ }
819
-@
820
-@ ::ttk::menubutton .files -text "Files"
834
+@
835
+@ frame .bb
836
+@ ::ttk::menubutton .bb.files -text "Files"
821837
 @ toplevel .wfiles
822838
 @ wm withdraw .wfiles
823839
 @ update idletasks
824840
 @ wm transient .wfiles .
825841
 @ wm overrideredirect .wfiles 1
826842
 @ listbox .wfiles.lb -width 0 -height $CFG(LB_HEIGHT) -activestyle none \
827843
 @ -yscroll {.wfiles.sb set}
828844
 @ ::ttk::scrollbar .wfiles.sb -command {.wfiles.lb yview}
829845
 @ grid .wfiles.lb .wfiles.sb -sticky ns
830
-@ bind .files <1> {
846
+@ bind .bb.files <1> {
831847
 @ set x [winfo rootx %W]
832848
 @ set y [expr {[winfo rooty %W]+[winfo height %W]}]
833849
 @ wm geometry .wfiles +$x+$y
834850
 @ wm deiconify .wfiles
835851
 @ focus .wfiles.lb
@@ -848,16 +864,16 @@
848864
 @ }
849865
 @ bind .wfiles.lb <Motion> {
850866
 @ %W selection clear 0 end
851867
 @ %W selection set @%x,%y
852868
 @ }
853
-@
869
+@
854870
 @ foreach {side syncCol} {A .txtB B .txtA} {
855871
 @ set ln .ln$side
856872
 @ text $ln
857873
 @ $ln tag config - -justify right
858
-@
874
+@
859875
 @ set txt .txt$side
860876
 @ text $txt -width $CFG(WIDTH) -height $CFG(HEIGHT) -wrap none \
861877
 @ -xscroll "sync-x $syncCol"
862878
 @ catch {$txt config -tabstyle wordprocessor} ;# Required for Tk>=8.5
863879
 @ foreach tag {add rm chng} {
@@ -866,11 +882,11 @@
866882
 @ }
867883
 @ $txt tag config fn -background $CFG(FN_BG) -foreground $CFG(FN_FG) \
868884
 @ -justify center
869885
 @ }
870886
 @ text .mkr
871
-@
887
+@
872888
 @ foreach c [cols] {
873889
 @ set keyPrefix [string toupper [colType $c]]_COL_
874890
 @ if {[tk windowingsystem] eq "win32"} {$c config -font {courier 9}}
875891
 @ $c config -bg $CFG(${keyPrefix}BG) -fg $CFG(${keyPrefix}FG) -borderwidth 0 \
876892
 @ -padx $CFG(PADX) -yscroll sync-y
@@ -878,34 +894,50 @@
878894
 @ -foreground $CFG(HR_FG)
879895
 @ $c tag config fn -spacing1 $CFG(FN_PAD) -spacing3 $CFG(FN_PAD)
880896
 @ bindtags $c ". $c Text all"
881897
 @ bind $c <1> {focus %W}
882898
 @ }
883
-@
899
+@
884900
 @ ::ttk::scrollbar .sby -command {.txtA yview} -orient vertical
885901
 @ ::ttk::scrollbar .sbxA -command {.txtA xview} -orient horizontal
886902
 @ ::ttk::scrollbar .sbxB -command {.txtB xview} -orient horizontal
887903
 @ frame .spacer
888
-@
904
+@
889905
 @ if {[readDiffs $fossilcmd] == 0} {
890906
 @ tk_messageBox -type ok -title $CFG(TITLE) -message "No changes"
891907
 @ exit
892908
 @ }
893909
 @ update idletasks
894
-@
910
+@
911
+@ proc saveDiff {} {
912
+@ set fn [tk_getSaveFile]
913
+@ set out [open $fn wb]
914
+@ puts $out "set fossilcmd {}"
915
+@ puts $out "set difftxt [list $::difftxt]"
916
+@ puts $out "set prog [list $::prog]"
917
+@ puts $out "eval \$prog"
918
+@ close $out
919
+@ }
920
+@ ::ttk::button .bb.quit -text {Quit} -command exit
921
+@ ::ttk::button .bb.save -text {Save As...} -command saveDiff
922
+@ pack .bb.quit -side left
923
+@ pack .bb.save -side left
924
+@ pack .bb.files -side left
895925
 @ grid rowconfigure . 1 -weight 1
896926
 @ grid columnconfigure . 1 -weight 1
897927
 @ grid columnconfigure . 4 -weight 1
898
-@ grid .files -row 0 -columnspan 6
928
+@ grid .bb -row 0 -columnspan 6
899929
 @ eval grid [cols] -row 1 -sticky nsew
900930
 @ grid .sby -row 1 -column 5 -sticky ns
901931
 @ grid .sbxA -row 2 -columnspan 2 -sticky ew
902932
 @ grid .spacer -row 2 -column 2
903933
 @ grid .sbxB -row 2 -column 3 -columnspan 2 -sticky ew
904
-@
934
+@
905935
 @ .spacer config -height [winfo height .sbxA]
906936
 @ wm deiconify .
937
+@ }
938
+@ eval $prog
907939
 ;
908940
909941
 /*
910942
 ** Show diff output in a Tcl/Tk window, in response to the --tk option
911943
 ** to the diff command.
912944
--- src/diffcmd.c
+++ src/diffcmd.c
@@ -598,12 +598,13 @@
598 }
599
600 /* A Tcl/Tk script used to render diff output.
601 */
602 static const char zDiffScript[] =
 
603 @ package require Tk
604 @
605 @ array set CFG {
606 @ TITLE {Fossil Diff}
607 @ LN_COL_BG #dddddd
608 @ LN_COL_FG #444444
609 @ TXT_COL_BG #ffffff
@@ -622,69 +623,84 @@
622 @ PADX 5
623 @ WIDTH 80
624 @ HEIGHT 45
625 @ LB_HEIGHT 25
626 @ }
627 @
628 @ if {![namespace exists ttk]} {
629 @ interp alias {} ::ttk::scrollbar {} ::scrollbar
630 @ interp alias {} ::ttk::menubutton {} ::menubutton
631 @ }
632 @
633 @ proc dehtml {x} {
634 @ set x [regsub -all {<[^>]*>} $x {}]
635 @ return [string map {&amp; & &lt; < &gt; > &#39; ' &quot; \"} $x]
636 @ }
637 @
638 @ proc cols {} {
639 @ return [list .lnA .txtA .mkr .lnB .txtB]
640 @ }
641 @
642 @ proc colType {c} {
643 @ regexp {[a-z]+} $c type
644 @ return $type
645 @ }
646 @
 
 
 
 
 
 
 
 
647 @ proc readDiffs {fossilcmd} {
648 @ set in [open $fossilcmd r]
649 @ fconfigure $in -encoding utf-8
 
 
 
 
 
 
 
650 @ set nDiffs 0
651 @ array set widths {txt 0 ln 0 mkr 0}
652 @ while {[gets $in line] != -1} {
653 @ if {![regexp {^=+\s+(.*?)\s+=+$} $line all fn]} {
654 @ continue
655 @ }
656 @ if {[string compare -length 6 [gets $in] "<table"]} {
657 @ continue
658 @ }
659 @ incr nDiffs
660 @ set idx [expr {$nDiffs > 1 ? [.txtA index end] : "1.0"}]
661 @ .wfiles.lb insert end $fn
662 @
663 @ foreach c [cols] {
664 @ while {[gets $in] ne "<pre>"} continue
665 @
666 @ if {$nDiffs > 1} {
667 @ $c insert end \n -
668 @ }
669 @ if {[colType $c] eq "txt"} {
670 @ $c insert end $fn\n fn
671 @ } else {
672 @ $c insert end \n fn
673 @ }
674 @ $c insert end \n -
675 @
676 @ set type [colType $c]
677 @ set str {}
678 @ while {[set line [gets $in]] ne "</pre>"} {
679 @ set len [string length [dehtml $line]]
680 @ if {$len > $widths($type)} {
681 @ set widths($type) $len
682 @ }
683 @ append str $line\n
684 @ }
685 @
686 @ set re {<span class="diff([a-z]+)">([^<]*)</span>}
687 @ # Use \r as separator since it can't appear in the diff output (it gets
688 @ # converted to a space).
689 @ set str [regsub -all $re $str "\r\\1\r\\2\r"]
690 @ foreach {pre class mid} [split $str \r] {
@@ -694,12 +710,11 @@
694 @ $c insert end [dehtml $pre] -
695 @ }
696 @ }
697 @ }
698 @ }
699 @ close $in
700 @
701 @ foreach c [cols] {
702 @ set type [colType $c]
703 @ if {$type ne "txt"} {
704 @ $c config -width $widths($type)
705 @ }
@@ -707,19 +722,19 @@
707 @ }
708 @ if {$nDiffs <= [.wfiles.lb cget -height]} {
709 @ .wfiles.lb config -height $nDiffs
710 @ grid remove .wfiles.sb
711 @ }
712 @
713 @ return $nDiffs
714 @ }
715 @
716 @ proc viewDiff {idx} {
717 @ .txtA yview $idx
718 @ .txtA xview moveto 0
719 @ }
720 @
721 @ proc cycleDiffs {{reverse 0}} {
722 @ if {$reverse} {
723 @ set range [.txtA tag prevrange fn @0,0 1.0]
724 @ if {$range eq ""} {
725 @ viewDiff {fn.last -1c}
@@ -733,36 +748,36 @@
733 @ } else {
734 @ viewDiff [lindex $range 0]
735 @ }
736 @ }
737 @ }
738 @
739 @ proc xvis {col} {
740 @ set view [$col xview]
741 @ return [expr {[lindex $view 1]-[lindex $view 0]}]
742 @ }
743 @
744 @ proc scroll-x {args} {
745 @ set c .txt[expr {[xvis .txtA] < [xvis .txtB] ? "A" : "B"}]
746 @ eval $c xview $args
747 @ }
748 @
749 @ interp alias {} scroll-y {} .txtA yview
750 @
751 @ proc noop {args} {}
752 @
753 @ proc enableSync {axis} {
754 @ update idletasks
755 @ interp alias {} sync-$axis {}
756 @ rename _sync-$axis sync-$axis
757 @ }
758 @
759 @ proc disableSync {axis} {
760 @ rename sync-$axis _sync-$axis
761 @ interp alias {} sync-$axis {} noop
762 @ }
763 @
764 @ proc sync-x {col first last} {
765 @ disableSync x
766 @ $col xview moveto [expr {$first*[xvis $col]/($last-$first)}]
767 @ foreach side {A B} {
768 @ set sb .sbx$side
@@ -774,11 +789,11 @@
774 @ grid remove $sb
775 @ }
776 @ }
777 @ enableSync x
778 @ }
779 @
780 @ proc sync-y {first last} {
781 @ disableSync y
782 @ foreach c [cols] {
783 @ $c yview moveto $first
784 @ }
@@ -788,21 +803,21 @@
788 @ } else {
789 @ grid remove .sby
790 @ }
791 @ enableSync y
792 @ }
793 @
794 @ wm withdraw .
795 @ wm title . $CFG(TITLE)
796 @ wm iconname . $CFG(TITLE)
797 @ bind . <q> exit
798 @ bind . <Destroy> {after 0 exit}
799 @ bind . <Tab> {cycleDiffs; break}
800 @ bind . <<PrevWindow>> {cycleDiffs 1; break}
801 @ bind . <Return> {
802 @ event generate .files <1>
803 @ event generate .files <ButtonRelease-1>
804 @ break
805 @ }
806 @ foreach {key axis args} {
807 @ Up y {scroll -5 units}
808 @ Down y {scroll 5 units}
@@ -814,22 +829,23 @@
814 @ End y {moveto 1}
815 @ } {
816 @ bind . <$key> "scroll-$axis $args; break"
817 @ bind . <Shift-$key> continue
818 @ }
819 @
820 @ ::ttk::menubutton .files -text "Files"
 
821 @ toplevel .wfiles
822 @ wm withdraw .wfiles
823 @ update idletasks
824 @ wm transient .wfiles .
825 @ wm overrideredirect .wfiles 1
826 @ listbox .wfiles.lb -width 0 -height $CFG(LB_HEIGHT) -activestyle none \
827 @ -yscroll {.wfiles.sb set}
828 @ ::ttk::scrollbar .wfiles.sb -command {.wfiles.lb yview}
829 @ grid .wfiles.lb .wfiles.sb -sticky ns
830 @ bind .files <1> {
831 @ set x [winfo rootx %W]
832 @ set y [expr {[winfo rooty %W]+[winfo height %W]}]
833 @ wm geometry .wfiles +$x+$y
834 @ wm deiconify .wfiles
835 @ focus .wfiles.lb
@@ -848,16 +864,16 @@
848 @ }
849 @ bind .wfiles.lb <Motion> {
850 @ %W selection clear 0 end
851 @ %W selection set @%x,%y
852 @ }
853 @
854 @ foreach {side syncCol} {A .txtB B .txtA} {
855 @ set ln .ln$side
856 @ text $ln
857 @ $ln tag config - -justify right
858 @
859 @ set txt .txt$side
860 @ text $txt -width $CFG(WIDTH) -height $CFG(HEIGHT) -wrap none \
861 @ -xscroll "sync-x $syncCol"
862 @ catch {$txt config -tabstyle wordprocessor} ;# Required for Tk>=8.5
863 @ foreach tag {add rm chng} {
@@ -866,11 +882,11 @@
866 @ }
867 @ $txt tag config fn -background $CFG(FN_BG) -foreground $CFG(FN_FG) \
868 @ -justify center
869 @ }
870 @ text .mkr
871 @
872 @ foreach c [cols] {
873 @ set keyPrefix [string toupper [colType $c]]_COL_
874 @ if {[tk windowingsystem] eq "win32"} {$c config -font {courier 9}}
875 @ $c config -bg $CFG(${keyPrefix}BG) -fg $CFG(${keyPrefix}FG) -borderwidth 0 \
876 @ -padx $CFG(PADX) -yscroll sync-y
@@ -878,34 +894,50 @@
878 @ -foreground $CFG(HR_FG)
879 @ $c tag config fn -spacing1 $CFG(FN_PAD) -spacing3 $CFG(FN_PAD)
880 @ bindtags $c ". $c Text all"
881 @ bind $c <1> {focus %W}
882 @ }
883 @
884 @ ::ttk::scrollbar .sby -command {.txtA yview} -orient vertical
885 @ ::ttk::scrollbar .sbxA -command {.txtA xview} -orient horizontal
886 @ ::ttk::scrollbar .sbxB -command {.txtB xview} -orient horizontal
887 @ frame .spacer
888 @
889 @ if {[readDiffs $fossilcmd] == 0} {
890 @ tk_messageBox -type ok -title $CFG(TITLE) -message "No changes"
891 @ exit
892 @ }
893 @ update idletasks
894 @
 
 
 
 
 
 
 
 
 
 
 
 
 
 
895 @ grid rowconfigure . 1 -weight 1
896 @ grid columnconfigure . 1 -weight 1
897 @ grid columnconfigure . 4 -weight 1
898 @ grid .files -row 0 -columnspan 6
899 @ eval grid [cols] -row 1 -sticky nsew
900 @ grid .sby -row 1 -column 5 -sticky ns
901 @ grid .sbxA -row 2 -columnspan 2 -sticky ew
902 @ grid .spacer -row 2 -column 2
903 @ grid .sbxB -row 2 -column 3 -columnspan 2 -sticky ew
904 @
905 @ .spacer config -height [winfo height .sbxA]
906 @ wm deiconify .
 
 
907 ;
908
909 /*
910 ** Show diff output in a Tcl/Tk window, in response to the --tk option
911 ** to the diff command.
912
--- src/diffcmd.c
+++ src/diffcmd.c
@@ -598,12 +598,13 @@
598 }
599
600 /* A Tcl/Tk script used to render diff output.
601 */
602 static const char zDiffScript[] =
603 @ set prog {
604 @ package require Tk
605 @
606 @ array set CFG {
607 @ TITLE {Fossil Diff}
608 @ LN_COL_BG #dddddd
609 @ LN_COL_FG #444444
610 @ TXT_COL_BG #ffffff
@@ -622,69 +623,84 @@
623 @ PADX 5
624 @ WIDTH 80
625 @ HEIGHT 45
626 @ LB_HEIGHT 25
627 @ }
628 @
629 @ if {![namespace exists ttk]} {
630 @ interp alias {} ::ttk::scrollbar {} ::scrollbar
631 @ interp alias {} ::ttk::menubutton {} ::menubutton
632 @ }
633 @
634 @ proc dehtml {x} {
635 @ set x [regsub -all {<[^>]*>} $x {}]
636 @ return [string map {&amp; & &lt; < &gt; > &#39; ' &quot; \"} $x]
637 @ }
638 @
639 @ proc cols {} {
640 @ return [list .lnA .txtA .mkr .lnB .txtB]
641 @ }
642 @
643 @ proc colType {c} {
644 @ regexp {[a-z]+} $c type
645 @ return $type
646 @ }
647 @
648 @ proc getLine {difftxt N iivar} {
649 @ upvar $iivar ii
650 @ if {$ii>=$N} {return -1}
651 @ set x [lindex $difftxt $ii]
652 @ incr ii
653 @ return $x
654 @ }
655 @
656 @ proc readDiffs {fossilcmd} {
657 @ global difftxt
658 @ if {![info exists difftxt]} {
659 @ set in [open $fossilcmd r]
660 @ fconfigure $in -encoding utf-8
661 @ set difftxt [split [read $in] \n]
662 @ close $in
663 @ }
664 @ set N [llength $difftxt]
665 @ set ii 0
666 @ set nDiffs 0
667 @ array set widths {txt 0 ln 0 mkr 0}
668 @ while {[set line [getLine $difftxt $N ii]] != -1} {
669 @ if {![regexp {^=+\s+(.*?)\s+=+$} $line all fn]} {
670 @ continue
671 @ }
672 @ if {[string compare -length 6 [getLine $difftxt $N ii] "<table"]} {
673 @ continue
674 @ }
675 @ incr nDiffs
676 @ set idx [expr {$nDiffs > 1 ? [.txtA index end] : "1.0"}]
677 @ .wfiles.lb insert end $fn
678 @
679 @ foreach c [cols] {
680 @ while {[getLine $difftxt $N ii] ne "<pre>"} continue
681 @
682 @ if {$nDiffs > 1} {
683 @ $c insert end \n -
684 @ }
685 @ if {[colType $c] eq "txt"} {
686 @ $c insert end $fn\n fn
687 @ } else {
688 @ $c insert end \n fn
689 @ }
690 @ $c insert end \n -
691 @
692 @ set type [colType $c]
693 @ set str {}
694 @ while {[set line [getLine $difftxt $N ii]] ne "</pre>"} {
695 @ set len [string length [dehtml $line]]
696 @ if {$len > $widths($type)} {
697 @ set widths($type) $len
698 @ }
699 @ append str $line\n
700 @ }
701 @
702 @ set re {<span class="diff([a-z]+)">([^<]*)</span>}
703 @ # Use \r as separator since it can't appear in the diff output (it gets
704 @ # converted to a space).
705 @ set str [regsub -all $re $str "\r\\1\r\\2\r"]
706 @ foreach {pre class mid} [split $str \r] {
@@ -694,12 +710,11 @@
710 @ $c insert end [dehtml $pre] -
711 @ }
712 @ }
713 @ }
714 @ }
715 @
 
716 @ foreach c [cols] {
717 @ set type [colType $c]
718 @ if {$type ne "txt"} {
719 @ $c config -width $widths($type)
720 @ }
@@ -707,19 +722,19 @@
722 @ }
723 @ if {$nDiffs <= [.wfiles.lb cget -height]} {
724 @ .wfiles.lb config -height $nDiffs
725 @ grid remove .wfiles.sb
726 @ }
727 @
728 @ return $nDiffs
729 @ }
730 @
731 @ proc viewDiff {idx} {
732 @ .txtA yview $idx
733 @ .txtA xview moveto 0
734 @ }
735 @
736 @ proc cycleDiffs {{reverse 0}} {
737 @ if {$reverse} {
738 @ set range [.txtA tag prevrange fn @0,0 1.0]
739 @ if {$range eq ""} {
740 @ viewDiff {fn.last -1c}
@@ -733,36 +748,36 @@
748 @ } else {
749 @ viewDiff [lindex $range 0]
750 @ }
751 @ }
752 @ }
753 @
754 @ proc xvis {col} {
755 @ set view [$col xview]
756 @ return [expr {[lindex $view 1]-[lindex $view 0]}]
757 @ }
758 @
759 @ proc scroll-x {args} {
760 @ set c .txt[expr {[xvis .txtA] < [xvis .txtB] ? "A" : "B"}]
761 @ eval $c xview $args
762 @ }
763 @
764 @ interp alias {} scroll-y {} .txtA yview
765 @
766 @ proc noop {args} {}
767 @
768 @ proc enableSync {axis} {
769 @ update idletasks
770 @ interp alias {} sync-$axis {}
771 @ rename _sync-$axis sync-$axis
772 @ }
773 @
774 @ proc disableSync {axis} {
775 @ rename sync-$axis _sync-$axis
776 @ interp alias {} sync-$axis {} noop
777 @ }
778 @
779 @ proc sync-x {col first last} {
780 @ disableSync x
781 @ $col xview moveto [expr {$first*[xvis $col]/($last-$first)}]
782 @ foreach side {A B} {
783 @ set sb .sbx$side
@@ -774,11 +789,11 @@
789 @ grid remove $sb
790 @ }
791 @ }
792 @ enableSync x
793 @ }
794 @
795 @ proc sync-y {first last} {
796 @ disableSync y
797 @ foreach c [cols] {
798 @ $c yview moveto $first
799 @ }
@@ -788,21 +803,21 @@
803 @ } else {
804 @ grid remove .sby
805 @ }
806 @ enableSync y
807 @ }
808 @
809 @ wm withdraw .
810 @ wm title . $CFG(TITLE)
811 @ wm iconname . $CFG(TITLE)
812 @ bind . <q> exit
813 @ bind . <Destroy> {after 0 exit}
814 @ bind . <Tab> {cycleDiffs; break}
815 @ bind . <<PrevWindow>> {cycleDiffs 1; break}
816 @ bind . <Return> {
817 @ event generate .bb.files <1>
818 @ event generate .bb.files <ButtonRelease-1>
819 @ break
820 @ }
821 @ foreach {key axis args} {
822 @ Up y {scroll -5 units}
823 @ Down y {scroll 5 units}
@@ -814,22 +829,23 @@
829 @ End y {moveto 1}
830 @ } {
831 @ bind . <$key> "scroll-$axis $args; break"
832 @ bind . <Shift-$key> continue
833 @ }
834 @
835 @ frame .bb
836 @ ::ttk::menubutton .bb.files -text "Files"
837 @ toplevel .wfiles
838 @ wm withdraw .wfiles
839 @ update idletasks
840 @ wm transient .wfiles .
841 @ wm overrideredirect .wfiles 1
842 @ listbox .wfiles.lb -width 0 -height $CFG(LB_HEIGHT) -activestyle none \
843 @ -yscroll {.wfiles.sb set}
844 @ ::ttk::scrollbar .wfiles.sb -command {.wfiles.lb yview}
845 @ grid .wfiles.lb .wfiles.sb -sticky ns
846 @ bind .bb.files <1> {
847 @ set x [winfo rootx %W]
848 @ set y [expr {[winfo rooty %W]+[winfo height %W]}]
849 @ wm geometry .wfiles +$x+$y
850 @ wm deiconify .wfiles
851 @ focus .wfiles.lb
@@ -848,16 +864,16 @@
864 @ }
865 @ bind .wfiles.lb <Motion> {
866 @ %W selection clear 0 end
867 @ %W selection set @%x,%y
868 @ }
869 @
870 @ foreach {side syncCol} {A .txtB B .txtA} {
871 @ set ln .ln$side
872 @ text $ln
873 @ $ln tag config - -justify right
874 @
875 @ set txt .txt$side
876 @ text $txt -width $CFG(WIDTH) -height $CFG(HEIGHT) -wrap none \
877 @ -xscroll "sync-x $syncCol"
878 @ catch {$txt config -tabstyle wordprocessor} ;# Required for Tk>=8.5
879 @ foreach tag {add rm chng} {
@@ -866,11 +882,11 @@
882 @ }
883 @ $txt tag config fn -background $CFG(FN_BG) -foreground $CFG(FN_FG) \
884 @ -justify center
885 @ }
886 @ text .mkr
887 @
888 @ foreach c [cols] {
889 @ set keyPrefix [string toupper [colType $c]]_COL_
890 @ if {[tk windowingsystem] eq "win32"} {$c config -font {courier 9}}
891 @ $c config -bg $CFG(${keyPrefix}BG) -fg $CFG(${keyPrefix}FG) -borderwidth 0 \
892 @ -padx $CFG(PADX) -yscroll sync-y
@@ -878,34 +894,50 @@
894 @ -foreground $CFG(HR_FG)
895 @ $c tag config fn -spacing1 $CFG(FN_PAD) -spacing3 $CFG(FN_PAD)
896 @ bindtags $c ". $c Text all"
897 @ bind $c <1> {focus %W}
898 @ }
899 @
900 @ ::ttk::scrollbar .sby -command {.txtA yview} -orient vertical
901 @ ::ttk::scrollbar .sbxA -command {.txtA xview} -orient horizontal
902 @ ::ttk::scrollbar .sbxB -command {.txtB xview} -orient horizontal
903 @ frame .spacer
904 @
905 @ if {[readDiffs $fossilcmd] == 0} {
906 @ tk_messageBox -type ok -title $CFG(TITLE) -message "No changes"
907 @ exit
908 @ }
909 @ update idletasks
910 @
911 @ proc saveDiff {} {
912 @ set fn [tk_getSaveFile]
913 @ set out [open $fn wb]
914 @ puts $out "set fossilcmd {}"
915 @ puts $out "set difftxt [list $::difftxt]"
916 @ puts $out "set prog [list $::prog]"
917 @ puts $out "eval \$prog"
918 @ close $out
919 @ }
920 @ ::ttk::button .bb.quit -text {Quit} -command exit
921 @ ::ttk::button .bb.save -text {Save As...} -command saveDiff
922 @ pack .bb.quit -side left
923 @ pack .bb.save -side left
924 @ pack .bb.files -side left
925 @ grid rowconfigure . 1 -weight 1
926 @ grid columnconfigure . 1 -weight 1
927 @ grid columnconfigure . 4 -weight 1
928 @ grid .bb -row 0 -columnspan 6
929 @ eval grid [cols] -row 1 -sticky nsew
930 @ grid .sby -row 1 -column 5 -sticky ns
931 @ grid .sbxA -row 2 -columnspan 2 -sticky ew
932 @ grid .spacer -row 2 -column 2
933 @ grid .sbxB -row 2 -column 3 -columnspan 2 -sticky ew
934 @
935 @ .spacer config -height [winfo height .sbxA]
936 @ wm deiconify .
937 @ }
938 @ eval $prog
939 ;
940
941 /*
942 ** Show diff output in a Tcl/Tk window, in response to the --tk option
943 ** to the diff command.
944

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button