Fossil SCM

Proposed enhancements to the --tk diff viewer from Ramon Ribó.

drh 2014-10-22 13:54 trunk
Commit cbd4dca6807d95d73c22cb02893887efc1b51655
Parent bf3db3d16e15ee9…
1 file changed +348 -2
~ src/diffcmd.c
M src/diffcmd.c
+348 -2
--- src/diffcmd.c
+++ src/diffcmd.c
@@ -783,10 +783,299 @@
783783
 @ } else {
784784
 @ viewDiff [lindex $range 0]
785785
 @ }
786786
 @ }
787787
 @ }
788
+@
789
+@ proc prev_next_diff { prev_next } {
790
+@ set range [.txtA tag nextrange active 1.0 end]
791
+@ if {$prev_next eq "prev"} {
792
+@ set idx0 [lindex $range 0]
793
+@ if {$idx0 eq ""} {set idx0 end}
794
+@ if {[.txtA compare $idx0 > @0,[winfo height .txtA]]} {
795
+@ set idx0 [.txtA index @0,[winfo height .txtA]]
796
+@ }
797
+@ set idx ""
798
+@ foreach tag [list add rm chng fn] {
799
+@ foreach w [list .txtA .txtB] {
800
+@ lassign [$w tag prevrange $tag $idx0 1.0] a b
801
+@ if { $idx eq "" || ($a ne "" && [$w compare $a > $idx]) } {
802
+@ set idx $a
803
+@ set idx_end $b
804
+@ set tagB $tag
805
+@ set wB $w
806
+@ }
807
+@ }
808
+@ }
809
+@ if {$idx ne ""} {
810
+@ while 1 {
811
+@ lassign [$wB tag prevrange $tagB $idx 1.0] a b
812
+@ if {$b ne "" && [$wB compare $b == "$idx - 1 l lineend"]} {
813
+@ set idx $a
814
+@ } else {
815
+@ break
816
+@ }
817
+@ }
818
+@ }
819
+@ } else {
820
+@ set idx0 [lindex $range 1]
821
+@ if { $idx0 eq "" } { set idx0 1.0 }
822
+@ if { [.txtA compare $idx0 < @0,0] } {
823
+@ set idx0 [.txtA index @0,0]
824
+@ }
825
+@ set idx ""
826
+@ foreach tag [list add rm chng fn] {
827
+@ foreach w [list .txtA .txtB] {
828
+@ lassign [$w tag nextrange $tag $idx0 end] a b
829
+@ if { $idx eq "" || ($a ne "" && [$w compare $a < $idx]) } {
830
+@ set idx $a
831
+@ set idx_end $b
832
+@ set tagB $tag
833
+@ set wB $w
834
+@ }
835
+@ }
836
+@ }
837
+@ if { $idx ne "" } {
838
+@ while 1 {
839
+@ lassign [$wB tag nextrange $tagB $idx_end end] a b
840
+@ if { $a ne "" && [$wB compare $a == "$idx_end + 1 l linestart"] } {
841
+@ set idx_end $b
842
+@ } else {
843
+@ break
844
+@ }
845
+@ }
846
+@ }
847
+@ }
848
+@ if { $idx eq "" } {
849
+@ bell
850
+@ return
851
+@ }
852
+@ set idx [.txtA index "$idx linestart"]
853
+@ if { $tagB ne "fn" } {
854
+@ set idx_end [.txtA index "$idx_end +1l linestart"]
855
+@ }
856
+@ .txtA tag remove active 1.0 end
857
+@ .txtA tag add active $idx $idx_end
858
+@ .txtA tag configure active -borderwidth 2 -relief raised\
859
+@ -background #eeeeee -foreground black
860
+@ if { $tagB ne "fn" } {
861
+@ .txtA tag lower active
862
+@ } else {
863
+@ .txtA tag raise active
864
+@ }
865
+@ .txtA see 1.0
866
+@ .txtA see $idx
867
+@ }
868
+@
869
+@ proc searchText {} {
870
+@ set rangeA [.txtA tag nextrange search 1.0 end]
871
+@ set rangeB [.txtB tag nextrange search 1.0 end]
872
+@ set idx0 [lindex $rangeA 1]
873
+@ if { $idx0 eq "" } { set idx0 [lindex $rangeB 1] }
874
+@ if { $idx0 eq "" } { set idx0 1.0 }
875
+@ set word [.bb.search get]
876
+@ if { [.txtA compare $idx0 < @0,0] } {
877
+@ set idx0 [.txtA index @0,0]
878
+@ }
879
+@ if { [info exists ::this_does_not_find] } {
880
+@ if { $::this_does_not_find eq [list $idx0 $word] } {
881
+@ set idx0 1.0
882
+@ }
883
+@ unset ::this_does_not_find
884
+@ }
885
+@ set idx ""
886
+@ foreach w [list .txtA .txtB] {
887
+@ foreach regexp [list 0 1] {
888
+@ switch $regexp {
889
+@ 0 { set rexFlag "-exact" }
890
+@ 1 { set rexFlag "-regexp" }
891
+@ }
892
+@ set err [catch {
893
+@ $w search -nocase $rexFlag -count count $word $idx0 end
894
+@ } idx_i]
895
+@ if {!$err && $idx_i ne ""
896
+@ && ($idx eq "" || [$w compare $idx_i < $idx])} {
897
+@ set idx $idx_i
898
+@ set countB $count
899
+@ set wB $w
900
+@ }
901
+@ }
902
+@ }
903
+@ .txtA tag remove search 1.0 end
904
+@ .txtB tag remove search 1.0 end
905
+@ if { $idx eq "" } {
906
+@ bell
907
+@ set ::this_does_not_find [list $idx0 $word]
908
+@ return
909
+@ }
910
+@ set idx_end [$wB index "$idx + $countB c"]
911
+@ $wB tag add search $idx $idx_end
912
+@ $wB tag configure search -borderwidth 2 -relief raised\
913
+@ -background orange -foreground black
914
+@ $wB tag raise search
915
+@ $wB see 1.0
916
+@ $wB see $idx
917
+@ }
918
+@
919
+@ proc reopen { action } {
920
+@ if { ![regexp {[|]\s*(.*)} $::fossilcmd {} cmdList] } { return }
921
+@ set f [lindex $cmdList 0]
922
+@ set args_with_arg \
923
+@ [list binary branch context c diff-binary from r to W width]
924
+@ set skip_args [list html internal i side-by-side y tk]
925
+@ lassign "" argsDict files
926
+@ for { set i 2 } { $i < [llength $cmdList] } { incr i } {
927
+@ if { [string match "-*" [lindex $cmdList $i]] } {
928
+@ set n [string trimleft [lindex $cmdList $i] "-"]
929
+@ if { $n in $args_with_arg } {
930
+@ dict set argsDict $n [lindex $cmdList $i+1]
931
+@ incr i
932
+@ } elseif { $n ni $skip_args } {
933
+@ dict set argsDict $n 1
934
+@ }
935
+@ } else {
936
+@ lappend files [lindex $cmdList $i]
937
+@ }
938
+@ }
939
+@ switch $action {
940
+@ togglewhitespace {
941
+@ if { [dict exists $argsDict w]
942
+@ || [dict exists $argsDict ignore-all-space] } {
943
+@ dict unset argsDict w
944
+@ dict unset argsDict ignore-all-space
945
+@ } else {
946
+@ dict set argsDict w 1
947
+@ }
948
+@ }
949
+@ onefile {
950
+@ set range [.txtA tag nextrange fn "@0,0" "@0,[winfo height .txtA] +1l"]
951
+@ if { $range eq "" } { return }
952
+@ set file [string trim [.txtA get {*}$range]]
953
+@ set files [list $file]
954
+@ regexp -line {local-root:\s+(.*)} [exec $f info] {} dir
955
+@ cd $dir
956
+@ }
957
+@ allfiles {
958
+@ set files ""
959
+@ }
960
+@ prev -
961
+@ next {
962
+@ set widget [focus]
963
+@ if { $widget eq ".txtA" } {
964
+@ set from_to from
965
+@ if { ![dict exists $argsDict from] } {
966
+@ dict set argsDict from current
967
+@ }
968
+@ } elseif { $widget eq ".txtB" } {
969
+@ set from_to to
970
+@ if { ![dict exists $argsDict to] } {
971
+@ dict set argsDict to ckout
972
+@ }
973
+@ } else {
974
+@ tk_messageBox -message "Click on one of the panes to select it"
975
+@ return
976
+@ }
977
+@ lassign "" parent child current tag
978
+@ set err [catch { exec $f info [dict get $argsDict $from_to] } info]
979
+@ if { $err } {
980
+@ if { [dict get $argsDict $from_to] eq "ckout" } {
981
+@ set err [catch { exec $f info } info]
982
+@ if { !$err } { regexp {checkout:\s+(\S+)} $info {} parent }
983
+@ } else {
984
+@ bell
985
+@ return
986
+@ }
987
+@ } else {
988
+@ regexp {uuid:\s+(\S+)\s+(\S+)} $info {} current date
989
+@ regexp {parent:\s+(\S+)} $info {} parent
990
+@ regexp {child:\s+(\S+)} $info {} child
991
+@ }
992
+@ if { [llength $files] == 1 } {
993
+@ set file [lindex $files 0]
994
+@ set err [catch { exec $f finfo -b -limit 100 $file } info]
995
+@ if { $err } {
996
+@ bell
997
+@ return
998
+@ }
999
+@ if { $current eq "" } {
1000
+@ if { $action eq "prev" } {
1001
+@ regexp {^\S+} $info tag
1002
+@ }
1003
+@ } else {
1004
+@ set current [string range $current 0 9]
1005
+@ set prev ""
1006
+@ set found 0
1007
+@ foreach line [split $info \n] {
1008
+@ regexp {(\S+)\s+(\S+)} $line {} currentL dateL
1009
+@ if { $found } {
1010
+@ set tag $currentL
1011
+@ break
1012
+@ } elseif { $currentL eq $current || $dateL < $date } {
1013
+@ if { $action eq "next" } {
1014
+@ set tag $prev
1015
+@ break
1016
+@ }
1017
+@ set found 1
1018
+@ }
1019
+@ set prev $currentL
1020
+@ }
1021
+@ }
1022
+@ } else {
1023
+@ if { $action eq "prev" } {
1024
+@ set tag $parent
1025
+@ } else {
1026
+@ set tag $child
1027
+@ }
1028
+@ }
1029
+@ if { $tag eq "" && $action eq "prev" } {
1030
+@ bell
1031
+@ return
1032
+@ }
1033
+@ if { $tag ne "" } {
1034
+@ dict set argsDict $from_to $tag
1035
+@ } else {
1036
+@ dict unset argsDict $from_to
1037
+@ }
1038
+@ if { $from_to eq "to" && ![dict exists $argsDict from] } {
1039
+@ dict set argsDict from current
1040
+@ }
1041
+@ }
1042
+@ }
1043
+@
1044
+@ set f_args ""
1045
+@ dict for "n v" $argsDict {
1046
+@ if { $n in $args_with_arg } {
1047
+@ lappend f_args -$n $v
1048
+@ } else {
1049
+@ lappend f_args -$n
1050
+@ }
1051
+@ }
1052
+@ lappend f_args {*}$files
1053
+@
1054
+@ # note: trying to put two contiguous "-" gives an error
1055
+@ exec $f diff -tk {*}$f_args &
1056
+@ exit
1057
+@ }
1058
+@
1059
+@ proc fossil_ui {} {
1060
+@ if { ![regexp {[|]\s*(.*)} $::fossilcmd {} cmdList] } { return }
1061
+@ set f [lindex $cmdList 0]
1062
+@ exec $f ui &
1063
+@ }
1064
+@
1065
+@ proc searchToggle {} {
1066
+@ set err [catch { pack info .bb.search }]
1067
+@ if { $err } {
1068
+@ pack .bb.search -side left -padx 5 -after .bb.files
1069
+@ tk::TabToWindow .bb.search
1070
+@ } else {
1071
+@ .txtA tag remove search 1.0 end
1072
+@ .txtB tag remove search 1.0 end
1073
+@ pack forget .bb.search
1074
+@ focus .
1075
+@ }
1076
+@ }
7881077
 @
7891078
 @ proc xvis {col} {
7901079
 @ set view [$col xview]
7911080
 @ return [expr {[lindex $view 1]-[lindex $view 0]}]
7921081
 @ }
@@ -938,11 +1227,11 @@
9381227
 @ ::ttk::scrollbar .sbxB -command {.txtB xview} -orient horizontal
9391228
 @ frame .spacer
9401229
 @
9411230
 @ if {[readDiffs $fossilcmd] == 0} {
9421231
 @ tk_messageBox -type ok -title $CFG(TITLE) -message "No changes"
943
-@ exit
1232
+@ #exit
9441233
 @ }
9451234
 @ update idletasks
9461235
 @
9471236
 @ proc saveDiff {} {
9481237
 @ set fn [tk_getSaveFile]
@@ -981,20 +1270,77 @@
9811270
 @ set cgt [.mkr search -all > 1.0 end]
9821271
 @ foreach c $clt {.mkr replace $c "$c +1 chars" >}
9831272
 @ foreach c $cgt {.mkr replace $c "$c +1 chars" <}
9841273
 @ .mkr config -state disabled
9851274
 @ }
1275
+@ proc bind_key_do { cmd } {
1276
+@ if { [focus] eq ".bb.search" } { return -code continue }
1277
+@ uplevel #0 $cmd
1278
+@ return -code break
1279
+@ }
1280
+@ ::ttk::menubutton .bb.actions -text "Actions" -menu .bb.actions.m
1281
+@ menu .bb.actions.m -tearoff 0
1282
+@ .bb.actions.m add command -label "Go to previous diff" -acc "p" -command "prev_next_diff prev"
1283
+@ .bb.actions.m add command -label "Go to next diff" -acc "n" -command "prev_next_diff next"
1284
+@ .bb.actions.m add separator
1285
+@ .bb.actions.m add command -label "Search" -acc "f" -command "searchToggle;"
1286
+@ .bb.actions.m add command -label "Toggle whitespace" -acc "w" -command "reopen togglewhitespace"
1287
+@ .bb.actions.m add separator
1288
+@ .bb.actions.m add command -label "View one file" -acc "1" -command "reopen onefile"
1289
+@ .bb.actions.m add command -label "View all files" -acc "a" -command "reopen allfiles"
1290
+@ .bb.actions.m add separator
1291
+@ .bb.actions.m add command -label "Older version" -acc "Shift-P" -command "reopen prev"
1292
+@ .bb.actions.m add command -label "Newer version" -acc "Shift-N" -command "reopen next"
1293
+@ .bb.actions.m add command -label "Fossil ui" -acc "u" -command "fossil_ui"
9861294
 @ ::ttk::button .bb.quit -text {Quit} -command exit
9871295
 @ ::ttk::button .bb.invert -text {Invert} -command invertDiff
9881296
 @ ::ttk::button .bb.save -text {Save As...} -command saveDiff
1297
+@ ::ttk::entry .bb.search -width 12
1298
+@
1299
+@ bind .bb.search <Return> "searchText; break"
1300
+@ bind .bb.search <Escape> "searchToggle; break"
1301
+@
1302
+@ bind . <Key-f> [list bind_key_do "searchToggle"]
1303
+@ bind . <Key-w> [list bind_key_do "reopen togglewhitespace"]
1304
+@ bind . <Key-1> [list bind_key_do "reopen onefile"]
1305
+@ bind . <Key-a> [list bind_key_do "reopen allfiles"]
1306
+@ bind . <Key-P> [list bind_key_do "reopen prev"]
1307
+@ bind . <Key-N> [list bind_key_do "reopen next"]
1308
+@ bind . <Key-u> [list bind_key_do "fossil_ui"]
1309
+@
1310
+@ lassign [list "(current)" "(ckout)"] from to
1311
+@ if { [regexp {[|]\s*(.*)} $::fossilcmd {} cmdList] } {
1312
+@ set f [lindex $cmdList 0]
1313
+@ if { [regexp {([-][-]?from|-r)\s+(\S+)} [join $cmdList " "] {} {} from] } {
1314
+@ set err [catch { exec $f info $from } info]
1315
+@ if { !$err } {
1316
+@ regexp {uuid:\s+(\S+)\s+(\S+)\s+(\S+)} $info {} from date time
1317
+@ set from "\[[string range $from 0 9]\] $date $time"
1318
+@ }
1319
+@ }
1320
+@ if { [regexp {([-][-]?to)\s+(\S+)} [join $cmdList " "] {} {} to] } {
1321
+@ set err [catch { exec $f info $to } info]
1322
+@ if { !$err } {
1323
+@ regexp {uuid:\s+(\S+)\s+(\S+)\s+(\S+)} $info {} to date time
1324
+@ set to "\[[string range $to 0 9]\] $date $time"
1325
+@ }
1326
+@ }
1327
+@ }
1328
+@
1329
+@ ttk::label .bb.from -text $from
1330
+@ ttk::label .bb.to -text $to
1331
+@
1332
+@ pack .bb.from -side left -padx "2 25"
9891333
 @ pack .bb.quit .bb.invert -side left
9901334
 @ if {$fossilcmd!=""} {pack .bb.save -side left}
9911335
 @ pack .bb.files -side left
1336
+@ pack .bb.actions -side left
1337
+@ pack .bb.to -side left -padx "25 2"
9921338
 @ grid rowconfigure . 1 -weight 1
9931339
 @ grid columnconfigure . 1 -weight 1
9941340
 @ grid columnconfigure . 4 -weight 1
995
-@ grid .bb -row 0 -columnspan 6
1341
+@ grid .bb -row 0 -columnspan 7
9961342
 @ eval grid [cols] -row 1 -sticky nsew
9971343
 @ grid .sby -row 1 -column 5 -sticky ns
9981344
 @ grid .sbxA -row 2 -columnspan 2 -sticky ew
9991345
 @ grid .spacer -row 2 -column 2
10001346
 @ grid .sbxB -row 2 -column 3 -columnspan 2 -sticky ew
10011347
--- src/diffcmd.c
+++ src/diffcmd.c
@@ -783,10 +783,299 @@
783 @ } else {
784 @ viewDiff [lindex $range 0]
785 @ }
786 @ }
787 @ }
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
788 @
789 @ proc xvis {col} {
790 @ set view [$col xview]
791 @ return [expr {[lindex $view 1]-[lindex $view 0]}]
792 @ }
@@ -938,11 +1227,11 @@
938 @ ::ttk::scrollbar .sbxB -command {.txtB xview} -orient horizontal
939 @ frame .spacer
940 @
941 @ if {[readDiffs $fossilcmd] == 0} {
942 @ tk_messageBox -type ok -title $CFG(TITLE) -message "No changes"
943 @ exit
944 @ }
945 @ update idletasks
946 @
947 @ proc saveDiff {} {
948 @ set fn [tk_getSaveFile]
@@ -981,20 +1270,77 @@
981 @ set cgt [.mkr search -all > 1.0 end]
982 @ foreach c $clt {.mkr replace $c "$c +1 chars" >}
983 @ foreach c $cgt {.mkr replace $c "$c +1 chars" <}
984 @ .mkr config -state disabled
985 @ }
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
986 @ ::ttk::button .bb.quit -text {Quit} -command exit
987 @ ::ttk::button .bb.invert -text {Invert} -command invertDiff
988 @ ::ttk::button .bb.save -text {Save As...} -command saveDiff
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
989 @ pack .bb.quit .bb.invert -side left
990 @ if {$fossilcmd!=""} {pack .bb.save -side left}
991 @ pack .bb.files -side left
 
 
992 @ grid rowconfigure . 1 -weight 1
993 @ grid columnconfigure . 1 -weight 1
994 @ grid columnconfigure . 4 -weight 1
995 @ grid .bb -row 0 -columnspan 6
996 @ eval grid [cols] -row 1 -sticky nsew
997 @ grid .sby -row 1 -column 5 -sticky ns
998 @ grid .sbxA -row 2 -columnspan 2 -sticky ew
999 @ grid .spacer -row 2 -column 2
1000 @ grid .sbxB -row 2 -column 3 -columnspan 2 -sticky ew
1001
--- src/diffcmd.c
+++ src/diffcmd.c
@@ -783,10 +783,299 @@
783 @ } else {
784 @ viewDiff [lindex $range 0]
785 @ }
786 @ }
787 @ }
788 @
789 @ proc prev_next_diff { prev_next } {
790 @ set range [.txtA tag nextrange active 1.0 end]
791 @ if {$prev_next eq "prev"} {
792 @ set idx0 [lindex $range 0]
793 @ if {$idx0 eq ""} {set idx0 end}
794 @ if {[.txtA compare $idx0 > @0,[winfo height .txtA]]} {
795 @ set idx0 [.txtA index @0,[winfo height .txtA]]
796 @ }
797 @ set idx ""
798 @ foreach tag [list add rm chng fn] {
799 @ foreach w [list .txtA .txtB] {
800 @ lassign [$w tag prevrange $tag $idx0 1.0] a b
801 @ if { $idx eq "" || ($a ne "" && [$w compare $a > $idx]) } {
802 @ set idx $a
803 @ set idx_end $b
804 @ set tagB $tag
805 @ set wB $w
806 @ }
807 @ }
808 @ }
809 @ if {$idx ne ""} {
810 @ while 1 {
811 @ lassign [$wB tag prevrange $tagB $idx 1.0] a b
812 @ if {$b ne "" && [$wB compare $b == "$idx - 1 l lineend"]} {
813 @ set idx $a
814 @ } else {
815 @ break
816 @ }
817 @ }
818 @ }
819 @ } else {
820 @ set idx0 [lindex $range 1]
821 @ if { $idx0 eq "" } { set idx0 1.0 }
822 @ if { [.txtA compare $idx0 < @0,0] } {
823 @ set idx0 [.txtA index @0,0]
824 @ }
825 @ set idx ""
826 @ foreach tag [list add rm chng fn] {
827 @ foreach w [list .txtA .txtB] {
828 @ lassign [$w tag nextrange $tag $idx0 end] a b
829 @ if { $idx eq "" || ($a ne "" && [$w compare $a < $idx]) } {
830 @ set idx $a
831 @ set idx_end $b
832 @ set tagB $tag
833 @ set wB $w
834 @ }
835 @ }
836 @ }
837 @ if { $idx ne "" } {
838 @ while 1 {
839 @ lassign [$wB tag nextrange $tagB $idx_end end] a b
840 @ if { $a ne "" && [$wB compare $a == "$idx_end + 1 l linestart"] } {
841 @ set idx_end $b
842 @ } else {
843 @ break
844 @ }
845 @ }
846 @ }
847 @ }
848 @ if { $idx eq "" } {
849 @ bell
850 @ return
851 @ }
852 @ set idx [.txtA index "$idx linestart"]
853 @ if { $tagB ne "fn" } {
854 @ set idx_end [.txtA index "$idx_end +1l linestart"]
855 @ }
856 @ .txtA tag remove active 1.0 end
857 @ .txtA tag add active $idx $idx_end
858 @ .txtA tag configure active -borderwidth 2 -relief raised\
859 @ -background #eeeeee -foreground black
860 @ if { $tagB ne "fn" } {
861 @ .txtA tag lower active
862 @ } else {
863 @ .txtA tag raise active
864 @ }
865 @ .txtA see 1.0
866 @ .txtA see $idx
867 @ }
868 @
869 @ proc searchText {} {
870 @ set rangeA [.txtA tag nextrange search 1.0 end]
871 @ set rangeB [.txtB tag nextrange search 1.0 end]
872 @ set idx0 [lindex $rangeA 1]
873 @ if { $idx0 eq "" } { set idx0 [lindex $rangeB 1] }
874 @ if { $idx0 eq "" } { set idx0 1.0 }
875 @ set word [.bb.search get]
876 @ if { [.txtA compare $idx0 < @0,0] } {
877 @ set idx0 [.txtA index @0,0]
878 @ }
879 @ if { [info exists ::this_does_not_find] } {
880 @ if { $::this_does_not_find eq [list $idx0 $word] } {
881 @ set idx0 1.0
882 @ }
883 @ unset ::this_does_not_find
884 @ }
885 @ set idx ""
886 @ foreach w [list .txtA .txtB] {
887 @ foreach regexp [list 0 1] {
888 @ switch $regexp {
889 @ 0 { set rexFlag "-exact" }
890 @ 1 { set rexFlag "-regexp" }
891 @ }
892 @ set err [catch {
893 @ $w search -nocase $rexFlag -count count $word $idx0 end
894 @ } idx_i]
895 @ if {!$err && $idx_i ne ""
896 @ && ($idx eq "" || [$w compare $idx_i < $idx])} {
897 @ set idx $idx_i
898 @ set countB $count
899 @ set wB $w
900 @ }
901 @ }
902 @ }
903 @ .txtA tag remove search 1.0 end
904 @ .txtB tag remove search 1.0 end
905 @ if { $idx eq "" } {
906 @ bell
907 @ set ::this_does_not_find [list $idx0 $word]
908 @ return
909 @ }
910 @ set idx_end [$wB index "$idx + $countB c"]
911 @ $wB tag add search $idx $idx_end
912 @ $wB tag configure search -borderwidth 2 -relief raised\
913 @ -background orange -foreground black
914 @ $wB tag raise search
915 @ $wB see 1.0
916 @ $wB see $idx
917 @ }
918 @
919 @ proc reopen { action } {
920 @ if { ![regexp {[|]\s*(.*)} $::fossilcmd {} cmdList] } { return }
921 @ set f [lindex $cmdList 0]
922 @ set args_with_arg \
923 @ [list binary branch context c diff-binary from r to W width]
924 @ set skip_args [list html internal i side-by-side y tk]
925 @ lassign "" argsDict files
926 @ for { set i 2 } { $i < [llength $cmdList] } { incr i } {
927 @ if { [string match "-*" [lindex $cmdList $i]] } {
928 @ set n [string trimleft [lindex $cmdList $i] "-"]
929 @ if { $n in $args_with_arg } {
930 @ dict set argsDict $n [lindex $cmdList $i+1]
931 @ incr i
932 @ } elseif { $n ni $skip_args } {
933 @ dict set argsDict $n 1
934 @ }
935 @ } else {
936 @ lappend files [lindex $cmdList $i]
937 @ }
938 @ }
939 @ switch $action {
940 @ togglewhitespace {
941 @ if { [dict exists $argsDict w]
942 @ || [dict exists $argsDict ignore-all-space] } {
943 @ dict unset argsDict w
944 @ dict unset argsDict ignore-all-space
945 @ } else {
946 @ dict set argsDict w 1
947 @ }
948 @ }
949 @ onefile {
950 @ set range [.txtA tag nextrange fn "@0,0" "@0,[winfo height .txtA] +1l"]
951 @ if { $range eq "" } { return }
952 @ set file [string trim [.txtA get {*}$range]]
953 @ set files [list $file]
954 @ regexp -line {local-root:\s+(.*)} [exec $f info] {} dir
955 @ cd $dir
956 @ }
957 @ allfiles {
958 @ set files ""
959 @ }
960 @ prev -
961 @ next {
962 @ set widget [focus]
963 @ if { $widget eq ".txtA" } {
964 @ set from_to from
965 @ if { ![dict exists $argsDict from] } {
966 @ dict set argsDict from current
967 @ }
968 @ } elseif { $widget eq ".txtB" } {
969 @ set from_to to
970 @ if { ![dict exists $argsDict to] } {
971 @ dict set argsDict to ckout
972 @ }
973 @ } else {
974 @ tk_messageBox -message "Click on one of the panes to select it"
975 @ return
976 @ }
977 @ lassign "" parent child current tag
978 @ set err [catch { exec $f info [dict get $argsDict $from_to] } info]
979 @ if { $err } {
980 @ if { [dict get $argsDict $from_to] eq "ckout" } {
981 @ set err [catch { exec $f info } info]
982 @ if { !$err } { regexp {checkout:\s+(\S+)} $info {} parent }
983 @ } else {
984 @ bell
985 @ return
986 @ }
987 @ } else {
988 @ regexp {uuid:\s+(\S+)\s+(\S+)} $info {} current date
989 @ regexp {parent:\s+(\S+)} $info {} parent
990 @ regexp {child:\s+(\S+)} $info {} child
991 @ }
992 @ if { [llength $files] == 1 } {
993 @ set file [lindex $files 0]
994 @ set err [catch { exec $f finfo -b -limit 100 $file } info]
995 @ if { $err } {
996 @ bell
997 @ return
998 @ }
999 @ if { $current eq "" } {
1000 @ if { $action eq "prev" } {
1001 @ regexp {^\S+} $info tag
1002 @ }
1003 @ } else {
1004 @ set current [string range $current 0 9]
1005 @ set prev ""
1006 @ set found 0
1007 @ foreach line [split $info \n] {
1008 @ regexp {(\S+)\s+(\S+)} $line {} currentL dateL
1009 @ if { $found } {
1010 @ set tag $currentL
1011 @ break
1012 @ } elseif { $currentL eq $current || $dateL < $date } {
1013 @ if { $action eq "next" } {
1014 @ set tag $prev
1015 @ break
1016 @ }
1017 @ set found 1
1018 @ }
1019 @ set prev $currentL
1020 @ }
1021 @ }
1022 @ } else {
1023 @ if { $action eq "prev" } {
1024 @ set tag $parent
1025 @ } else {
1026 @ set tag $child
1027 @ }
1028 @ }
1029 @ if { $tag eq "" && $action eq "prev" } {
1030 @ bell
1031 @ return
1032 @ }
1033 @ if { $tag ne "" } {
1034 @ dict set argsDict $from_to $tag
1035 @ } else {
1036 @ dict unset argsDict $from_to
1037 @ }
1038 @ if { $from_to eq "to" && ![dict exists $argsDict from] } {
1039 @ dict set argsDict from current
1040 @ }
1041 @ }
1042 @ }
1043 @
1044 @ set f_args ""
1045 @ dict for "n v" $argsDict {
1046 @ if { $n in $args_with_arg } {
1047 @ lappend f_args -$n $v
1048 @ } else {
1049 @ lappend f_args -$n
1050 @ }
1051 @ }
1052 @ lappend f_args {*}$files
1053 @
1054 @ # note: trying to put two contiguous "-" gives an error
1055 @ exec $f diff -tk {*}$f_args &
1056 @ exit
1057 @ }
1058 @
1059 @ proc fossil_ui {} {
1060 @ if { ![regexp {[|]\s*(.*)} $::fossilcmd {} cmdList] } { return }
1061 @ set f [lindex $cmdList 0]
1062 @ exec $f ui &
1063 @ }
1064 @
1065 @ proc searchToggle {} {
1066 @ set err [catch { pack info .bb.search }]
1067 @ if { $err } {
1068 @ pack .bb.search -side left -padx 5 -after .bb.files
1069 @ tk::TabToWindow .bb.search
1070 @ } else {
1071 @ .txtA tag remove search 1.0 end
1072 @ .txtB tag remove search 1.0 end
1073 @ pack forget .bb.search
1074 @ focus .
1075 @ }
1076 @ }
1077 @
1078 @ proc xvis {col} {
1079 @ set view [$col xview]
1080 @ return [expr {[lindex $view 1]-[lindex $view 0]}]
1081 @ }
@@ -938,11 +1227,11 @@
1227 @ ::ttk::scrollbar .sbxB -command {.txtB xview} -orient horizontal
1228 @ frame .spacer
1229 @
1230 @ if {[readDiffs $fossilcmd] == 0} {
1231 @ tk_messageBox -type ok -title $CFG(TITLE) -message "No changes"
1232 @ #exit
1233 @ }
1234 @ update idletasks
1235 @
1236 @ proc saveDiff {} {
1237 @ set fn [tk_getSaveFile]
@@ -981,20 +1270,77 @@
1270 @ set cgt [.mkr search -all > 1.0 end]
1271 @ foreach c $clt {.mkr replace $c "$c +1 chars" >}
1272 @ foreach c $cgt {.mkr replace $c "$c +1 chars" <}
1273 @ .mkr config -state disabled
1274 @ }
1275 @ proc bind_key_do { cmd } {
1276 @ if { [focus] eq ".bb.search" } { return -code continue }
1277 @ uplevel #0 $cmd
1278 @ return -code break
1279 @ }
1280 @ ::ttk::menubutton .bb.actions -text "Actions" -menu .bb.actions.m
1281 @ menu .bb.actions.m -tearoff 0
1282 @ .bb.actions.m add command -label "Go to previous diff" -acc "p" -command "prev_next_diff prev"
1283 @ .bb.actions.m add command -label "Go to next diff" -acc "n" -command "prev_next_diff next"
1284 @ .bb.actions.m add separator
1285 @ .bb.actions.m add command -label "Search" -acc "f" -command "searchToggle;"
1286 @ .bb.actions.m add command -label "Toggle whitespace" -acc "w" -command "reopen togglewhitespace"
1287 @ .bb.actions.m add separator
1288 @ .bb.actions.m add command -label "View one file" -acc "1" -command "reopen onefile"
1289 @ .bb.actions.m add command -label "View all files" -acc "a" -command "reopen allfiles"
1290 @ .bb.actions.m add separator
1291 @ .bb.actions.m add command -label "Older version" -acc "Shift-P" -command "reopen prev"
1292 @ .bb.actions.m add command -label "Newer version" -acc "Shift-N" -command "reopen next"
1293 @ .bb.actions.m add command -label "Fossil ui" -acc "u" -command "fossil_ui"
1294 @ ::ttk::button .bb.quit -text {Quit} -command exit
1295 @ ::ttk::button .bb.invert -text {Invert} -command invertDiff
1296 @ ::ttk::button .bb.save -text {Save As...} -command saveDiff
1297 @ ::ttk::entry .bb.search -width 12
1298 @
1299 @ bind .bb.search <Return> "searchText; break"
1300 @ bind .bb.search <Escape> "searchToggle; break"
1301 @
1302 @ bind . <Key-f> [list bind_key_do "searchToggle"]
1303 @ bind . <Key-w> [list bind_key_do "reopen togglewhitespace"]
1304 @ bind . <Key-1> [list bind_key_do "reopen onefile"]
1305 @ bind . <Key-a> [list bind_key_do "reopen allfiles"]
1306 @ bind . <Key-P> [list bind_key_do "reopen prev"]
1307 @ bind . <Key-N> [list bind_key_do "reopen next"]
1308 @ bind . <Key-u> [list bind_key_do "fossil_ui"]
1309 @
1310 @ lassign [list "(current)" "(ckout)"] from to
1311 @ if { [regexp {[|]\s*(.*)} $::fossilcmd {} cmdList] } {
1312 @ set f [lindex $cmdList 0]
1313 @ if { [regexp {([-][-]?from|-r)\s+(\S+)} [join $cmdList " "] {} {} from] } {
1314 @ set err [catch { exec $f info $from } info]
1315 @ if { !$err } {
1316 @ regexp {uuid:\s+(\S+)\s+(\S+)\s+(\S+)} $info {} from date time
1317 @ set from "\[[string range $from 0 9]\] $date $time"
1318 @ }
1319 @ }
1320 @ if { [regexp {([-][-]?to)\s+(\S+)} [join $cmdList " "] {} {} to] } {
1321 @ set err [catch { exec $f info $to } info]
1322 @ if { !$err } {
1323 @ regexp {uuid:\s+(\S+)\s+(\S+)\s+(\S+)} $info {} to date time
1324 @ set to "\[[string range $to 0 9]\] $date $time"
1325 @ }
1326 @ }
1327 @ }
1328 @
1329 @ ttk::label .bb.from -text $from
1330 @ ttk::label .bb.to -text $to
1331 @
1332 @ pack .bb.from -side left -padx "2 25"
1333 @ pack .bb.quit .bb.invert -side left
1334 @ if {$fossilcmd!=""} {pack .bb.save -side left}
1335 @ pack .bb.files -side left
1336 @ pack .bb.actions -side left
1337 @ pack .bb.to -side left -padx "25 2"
1338 @ grid rowconfigure . 1 -weight 1
1339 @ grid columnconfigure . 1 -weight 1
1340 @ grid columnconfigure . 4 -weight 1
1341 @ grid .bb -row 0 -columnspan 7
1342 @ eval grid [cols] -row 1 -sticky nsew
1343 @ grid .sby -row 1 -column 5 -sticky ns
1344 @ grid .sbxA -row 2 -columnspan 2 -sticky ew
1345 @ grid .spacer -row 2 -column 2
1346 @ grid .sbxB -row 2 -column 3 -columnspan 2 -sticky ew
1347

Keyboard Shortcuts

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