︙ | | | ︙ | |
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
proc Fsort {l} {
lsort -dictionary $l
}
# Compare two files or dirs
# Return true if equal
proc CompareFiles {file1 file2} {
global Pref
if {[catch {file lstat $file1 stat1}]} {
return 0
}
if {[catch {file lstat $file2 stat2}]} {
return 0
}
|
<
|
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
proc Fsort {l} {
lsort -dictionary $l
}
# Compare two files or dirs
# Return true if equal
proc CompareFiles {file1 file2} {
if {[catch {file lstat $file1 stat1}]} {
return 0
}
if {[catch {file lstat $file2 stat2}]} {
return 0
}
|
︙ | | | ︙ | |
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
|
if {$l1 eq $l2} {
return 1
}
file stat $file1 stat1
file stat $file2 stat2
}
# If contents is not checked, same size is enough to be equal
if {$stat1(size) == $stat2(size) && $Pref(dir,comparelevel) == 0} {
return 1
}
set ignorekey $Pref(dir,ignorekey)
# Different size is enough when doing binary compare
if {$stat1(size) != $stat2(size) && $Pref(dir,comparelevel) == 2 \
&& !$ignorekey} {
return 0
}
# Same size and time is always considered equal
if {$stat1(size) == $stat2(size) && $stat1(mtime) == $stat2(mtime)} {
return 1
}
# Don't check further if contents should not be checked
if {$Pref(dir,comparelevel) == 0} {
return 0
}
# Don't check further if any is a directory
if {$isdir1 || $isdir2} {
# Consider dirs equal until we implement something recursive
return 1
}
switch $Pref(dir,comparelevel) {
2 -
1 { # Check contents internally
set bufsz 65536
set eq 1
set ch1 [open $file1 r]
set ch2 [open $file2 r]
if {$Pref(dir,comparelevel) == 2} {
fconfigure $ch1 -translation binary
fconfigure $ch2 -translation binary
}
if {$ignorekey} {
# Assume that all keywords are in the first block
set f1 [read $ch1 $bufsz]
set f2 [read $ch2 $bufsz]
|
|
|
|
|
|
|
|
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
|
if {$l1 eq $l2} {
return 1
}
file stat $file1 stat1
file stat $file2 stat2
}
# If contents is not checked, same size is enough to be equal
if {$stat1(size) == $stat2(size) && $::Pref(dir,comparelevel) == 0} {
return 1
}
set ignorekey $::Pref(dir,ignorekey)
# Different size is enough when doing binary compare
if {$stat1(size) != $stat2(size) && $::Pref(dir,comparelevel) == 2 \
&& !$ignorekey} {
return 0
}
# Same size and time is always considered equal
if {$stat1(size) == $stat2(size) && $stat1(mtime) == $stat2(mtime)} {
return 1
}
# Don't check further if contents should not be checked
if {$::Pref(dir,comparelevel) == 0} {
return 0
}
# Don't check further if any is a directory
if {$isdir1 || $isdir2} {
# Consider dirs equal until we implement something recursive
return 1
}
switch $::Pref(dir,comparelevel) {
2 -
1 { # Check contents internally
set bufsz 65536
set eq 1
set ch1 [open $file1 r]
set ch2 [open $file2 r]
if {$::Pref(dir,comparelevel) == 2} {
fconfigure $ch1 -translation binary
fconfigure $ch2 -translation binary
}
if {$ignorekey} {
# Assume that all keywords are in the first block
set f1 [read $ch1 $bufsz]
set f2 [read $ch2 $bufsz]
|
︙ | | | ︙ | |
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
}
}
return $eq
}
# Returns the contents of a directory as a sorted list of full file paths.
proc DirContents {dir} {
global Pref
if {$::tcl_platform(platform) eq "windows"} {
# .-files are not treated specially on windows. * is enough to get all
set files [glob -directory $dir -nocomplain *]
} else {
set files [glob -directory $dir -nocomplain * {.[a-zA-Z]*}]
}
if {$Pref(dir,onlyrev)} {
# FIXA: move to rev and make general for other systems
set entries [file join $dir CVS Entries]
if {[file exists $entries]} {
set ch [open $entries r]
set data [read $ch]
close $ch
foreach line [split $data \n] {
|
<
|
|
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
}
}
return $eq
}
# Returns the contents of a directory as a sorted list of full file paths.
proc DirContents {dir} {
if {$::tcl_platform(platform) eq "windows"} {
# .-files are not treated specially on windows. * is enough to get all
set files [glob -directory $dir -nocomplain *]
} else {
set files [glob -directory $dir -nocomplain * {.[a-zA-Z]*}]
}
if {$::Pref(dir,onlyrev)} {
# FIXA: move to rev and make general for other systems
set entries [file join $dir CVS Entries]
if {[file exists $entries]} {
set ch [open $entries r]
set data [read $ch]
close $ch
foreach line [split $data \n] {
|
︙ | | | ︙ | |
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
|
set files2 {}
foreach file $files {
set full $file
set tail [file tail $file]
# Apply filters
if {[FileIsDirectory $full]} {
if {[llength $Pref(dir,incdirs)] == 0} {
set allowed 1
} else {
set allowed 0
foreach pat $Pref(dir,incdirs) {
if {[string match $pat $tail]} {
set allowed 1
break
}
}
}
if {$allowed} {
foreach pat $Pref(dir,exdirs) {
if {[string match $pat $tail]} {
set allowed 0
break
}
}
}
if {!$allowed} continue
} else {
if {[llength $Pref(dir,incfiles)] == 0} {
set allowed 1
} else {
set allowed 0
foreach pat $Pref(dir,incfiles) {
if {[string match $pat $tail]} {
set allowed 1
break
}
}
}
if {$allowed} {
foreach pat $Pref(dir,exfiles) {
if {[string match $pat $tail]} {
set allowed 0
break
}
}
}
if {!$allowed} continue
|
|
|
|
|
|
|
|
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
|
set files2 {}
foreach file $files {
set full $file
set tail [file tail $file]
# Apply filters
if {[FileIsDirectory $full]} {
if {[llength $::Pref(dir,incdirs)] == 0} {
set allowed 1
} else {
set allowed 0
foreach pat $::Pref(dir,incdirs) {
if {[string match $pat $tail]} {
set allowed 1
break
}
}
}
if {$allowed} {
foreach pat $::Pref(dir,exdirs) {
if {[string match $pat $tail]} {
set allowed 0
break
}
}
}
if {!$allowed} continue
} else {
if {[llength $::Pref(dir,incfiles)] == 0} {
set allowed 1
} else {
set allowed 0
foreach pat $::Pref(dir,incfiles) {
if {[string match $pat $tail]} {
set allowed 1
break
}
}
}
if {$allowed} {
foreach pat $::Pref(dir,exfiles) {
if {[string match $pat $tail]} {
set allowed 0
break
}
}
}
if {!$allowed} continue
|
︙ | | | ︙ | |
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
|
proc EditFile {file} {
locateEditor ::util(editor)
exec $::util(editor) $file &
}
# Pick a directory for compare
proc BrowseDir {dirVar entryW} {
global Pref
upvar "#0" $dirVar dir
set newdir $dir
while {$newdir != "." && ![FileIsDirectory $newdir]} {
set newdir [file dirname $newdir]
}
set newdir [tk_chooseDirectory -initialdir $newdir -title "Select Directory"]
|
<
|
234
235
236
237
238
239
240
241
242
243
244
245
246
247
|
proc EditFile {file} {
locateEditor ::util(editor)
exec $::util(editor) $file &
}
# Pick a directory for compare
proc BrowseDir {dirVar entryW} {
upvar "#0" $dirVar dir
set newdir $dir
while {$newdir != "." && ![FileIsDirectory $newdir]} {
set newdir [file dirname $newdir]
}
set newdir [tk_chooseDirectory -initialdir $newdir -title "Select Directory"]
|
︙ | | | ︙ | |
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
|
} else {
$tree collapseall
}
}
# Copy a file from one directory to the other
method CopyFile {node from} {
global dirdiff Pref
set lf [$tree rowattrib $node leftfull]
set rf [$tree rowattrib $node rightfull]
set parent [$tree parent $node]
set lp [$tree rowattrib $parent leftfull]
set rp [$tree rowattrib $parent rightfull]
|
|
|
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
|
} else {
$tree collapseall
}
}
# Copy a file from one directory to the other
method CopyFile {node from} {
global dirdiff
set lf [$tree rowattrib $node leftfull]
set rf [$tree rowattrib $node rightfull]
set parent [$tree parent $node]
set lp [$tree rowattrib $parent leftfull]
set rp [$tree rowattrib $parent rightfull]
|
︙ | | | ︙ | |
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
|
if {$rf eq ""} {
$w.bl configure -state disabled
}
}
# Compare two directories.
method CompareDirs {dir1 dir2 node} {
global Pref
if {$dir1 eq ""} {
set files1 {}
} else {
set files1 [DirContents $dir1]
}
if {$dir2 eq ""} {
set files2 {}
|
<
|
847
848
849
850
851
852
853
854
855
856
857
858
859
860
|
if {$rf eq ""} {
$w.bl configure -state disabled
}
}
# Compare two directories.
method CompareDirs {dir1 dir2 node} {
if {$dir1 eq ""} {
set files1 {}
} else {
set files1 [DirContents $dir1]
}
if {$dir2 eq ""} {
set files2 {}
|
︙ | | | ︙ | |
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
|
$win.m add cascade -menu $win.m.mo -label "Preferences" -underline 0
menu $win.m.mo
$win.m.mo add command -label "Prefs..." -command makeDirDiffPrefWin
$win.m.mo add cascade -label "Check" -menu $win.m.mo.mc
menu $win.m.mo.mc
$win.m.mo.mc add radiobutton -variable Pref(dir,comparelevel) -value 0 \
-label "Do not check contents"
$win.m.mo.mc add radiobutton -variable Pref(dir,comparelevel) -value 1 \
-label "Normal compare"
$win.m.mo.mc add radiobutton -variable Pref(dir,comparelevel) -value 2 \
-label "Exact compare"
$win.m.mo.mc add checkbutton -variable Pref(dir,ignorekey) \
-label "Ignore \$Keyword:\$"
$win.m.mo add cascade -label "Nice" -menu $win.m.mo.mn
menu $win.m.mo.mn
$win.m.mo.mn add radiobutton -variable [myvar nice] -value 1 \
-command [mymethod DoNice] -label 1
$win.m.mo.mn add radiobutton -variable [myvar nice] -value 50 \
|
|
|
|
|
|
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
|
$win.m add cascade -menu $win.m.mo -label "Preferences" -underline 0
menu $win.m.mo
$win.m.mo add command -label "Prefs..." -command makeDirDiffPrefWin
$win.m.mo add cascade -label "Check" -menu $win.m.mo.mc
menu $win.m.mo.mc
$win.m.mo.mc add radiobutton -variable ::Pref(dir,comparelevel) -value 0 \
-label "Do not check contents"
$win.m.mo.mc add radiobutton -variable ::Pref(dir,comparelevel) -value 1 \
-label "Normal compare"
$win.m.mo.mc add radiobutton -variable ::Pref(dir,comparelevel) -value 2 \
-label "Exact compare"
$win.m.mo.mc add checkbutton -variable ::Pref(dir,ignorekey) \
-label "Ignore \$Keyword:\$"
$win.m.mo add cascade -label "Nice" -menu $win.m.mo.mn
menu $win.m.mo.mn
$win.m.mo.mn add radiobutton -variable [myvar nice] -value 1 \
-command [mymethod DoNice] -label 1
$win.m.mo.mn add radiobutton -variable [myvar nice] -value 50 \
|
︙ | | | ︙ | |
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
|
ttk::button $win.bu -image $::img(upup) -command [mymethod UpDir] \
-underline 0
addBalloon $win.bu "Up in both."
bind $win <Alt-u> "$win.bu invoke"
#catch {font delete myfont}
#font create myfont -family $Pref(fontfamily) -size $Pref(fontsize)
ttk::entryX $win.e1 -textvariable dirdiff(leftDir) -width 30
ttk::button $win.bu1 -image $::img(up) -command [mymethod UpDir 1]
addBalloon $win.bu1 "Up in left."
ttk::button $win.bb1 -image $::img(browse) \
-command "[list BrowseDir dirdiff(leftDir) $win.e1]
[mymethod DoDirCompare]"
|
|
|
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
|
ttk::button $win.bu -image $::img(upup) -command [mymethod UpDir] \
-underline 0
addBalloon $win.bu "Up in both."
bind $win <Alt-u> "$win.bu invoke"
#catch {font delete myfont}
#font create myfont -family $::Pref(fontfamily) -size $::Pref(fontsize)
ttk::entryX $win.e1 -textvariable dirdiff(leftDir) -width 30
ttk::button $win.bu1 -image $::img(up) -command [mymethod UpDir 1]
addBalloon $win.bu1 "Up in left."
ttk::button $win.bb1 -image $::img(browse) \
-command "[list BrowseDir dirdiff(leftDir) $win.e1]
[mymethod DoDirCompare]"
|
︙ | | | ︙ | |
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
|
method DoNice {} {
$tree nice $nice
}
# Go up one level in directory hierarchy.
# 0 = both
method UpDir {{n 0}} {
global dirdiff Pref
switch $n {
0 {
set dirdiff(leftDir) [file dirname $dirdiff(leftDir)]
set dirdiff(rightDir) [file dirname $dirdiff(rightDir)]
$win.e1 xview end
$win.e2 xview end
}
|
|
|
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
|
method DoNice {} {
$tree nice $nice
}
# Go up one level in directory hierarchy.
# 0 = both
method UpDir {{n 0}} {
global dirdiff
switch $n {
0 {
set dirdiff(leftDir) [file dirname $dirdiff(leftDir)]
set dirdiff(rightDir) [file dirname $dirdiff(rightDir)]
$win.e1 xview end
$win.e2 xview end
}
|
︙ | | | ︙ | |
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
|
set ::TmpPref($item) $::Pref($item)
}
}
wm title $top "Eskil Directory Preferences"
set check [ttk::labelframe $top.check -text "Check" -padding 3]
ttk::radiobutton $check.rb1 -variable TmpPref(dir,comparelevel) -value 0 \
-text "Do not check contents"
ttk::radiobutton $check.rb2 -variable TmpPref(dir,comparelevel) -value 1 \
-text "Normal compare"
ttk::radiobutton $check.rb3 -variable TmpPref(dir,comparelevel) -value 2 \
-text "Exact compare"
grid $check.rb1 -sticky w -padx 3 -pady 3
grid $check.rb2 -sticky w -padx 3 -pady 3
grid $check.rb3 -sticky w -padx 3 -pady 3
grid columnconfigure $check {0 1 2} -uniform a -weight 1
set opts [ttk::labelframe $top.opts -text "Options" -padding 3]
ttk::checkbutton $opts.cb1 -variable TmpPref(dir,ignorekey) \
-text "Ignore \$Keyword:\$"
pack {*}[winfo children $opts] -side top -anchor w
set filter [ttk::labelframe $top.filter -text "Filter" -padding 3]
ttk::label $filter.l1 -text "Include Files" -anchor w
ttk::entryX $filter.e1 -width 20 -textvariable TmpPref(dir,incfiles)
ttk::label $filter.l2 -text "Exclude Files" -anchor w
ttk::entryX $filter.e2 -width 20 -textvariable TmpPref(dir,exfiles)
ttk::label $filter.l3 -text "Include Dirs" -anchor w
ttk::entryX $filter.e3 -width 20 -textvariable TmpPref(dir,incdirs)
ttk::label $filter.l4 -text "Exclude Dirs" -anchor w
ttk::entryX $filter.e4 -width 20 -textvariable TmpPref(dir,exdirs)
ttk::checkbutton $filter.cb1 -text "Only revision controlled" \
-variable TmpPref(dir,onlyrev)
grid $filter.l1 $filter.e1 -sticky we -padx 3 -pady 3
grid $filter.l2 $filter.e2 -sticky we -padx 3 -pady 3
grid $filter.l3 $filter.e3 -sticky we -padx 3 -pady 3
grid $filter.l4 $filter.e4 -sticky we -padx 3 -pady 3
grid $filter.cb1 - -sticky w -padx 3 -pady 3
grid columnconfigure $filter 1 -weight 1
|
|
|
|
|
|
|
|
|
|
|
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
|
set ::TmpPref($item) $::Pref($item)
}
}
wm title $top "Eskil Directory Preferences"
set check [ttk::labelframe $top.check -text "Check" -padding 3]
ttk::radiobutton $check.rb1 -variable ::TmpPref(dir,comparelevel) -value 0 \
-text "Do not check contents"
ttk::radiobutton $check.rb2 -variable ::TmpPref(dir,comparelevel) -value 1 \
-text "Normal compare"
ttk::radiobutton $check.rb3 -variable ::TmpPref(dir,comparelevel) -value 2 \
-text "Exact compare"
grid $check.rb1 -sticky w -padx 3 -pady 3
grid $check.rb2 -sticky w -padx 3 -pady 3
grid $check.rb3 -sticky w -padx 3 -pady 3
grid columnconfigure $check {0 1 2} -uniform a -weight 1
set opts [ttk::labelframe $top.opts -text "Options" -padding 3]
ttk::checkbutton $opts.cb1 -variable ::TmpPref(dir,ignorekey) \
-text "Ignore \$Keyword:\$"
pack {*}[winfo children $opts] -side top -anchor w
set filter [ttk::labelframe $top.filter -text "Filter" -padding 3]
ttk::label $filter.l1 -text "Include Files" -anchor w
ttk::entryX $filter.e1 -width 20 -textvariable ::TmpPref(dir,incfiles)
ttk::label $filter.l2 -text "Exclude Files" -anchor w
ttk::entryX $filter.e2 -width 20 -textvariable ::TmpPref(dir,exfiles)
ttk::label $filter.l3 -text "Include Dirs" -anchor w
ttk::entryX $filter.e3 -width 20 -textvariable ::TmpPref(dir,incdirs)
ttk::label $filter.l4 -text "Exclude Dirs" -anchor w
ttk::entryX $filter.e4 -width 20 -textvariable ::TmpPref(dir,exdirs)
ttk::checkbutton $filter.cb1 -text "Only revision controlled" \
-variable ::TmpPref(dir,onlyrev)
grid $filter.l1 $filter.e1 -sticky we -padx 3 -pady 3
grid $filter.l2 $filter.e2 -sticky we -padx 3 -pady 3
grid $filter.l3 $filter.e3 -sticky we -padx 3 -pady 3
grid $filter.l4 $filter.e4 -sticky we -padx 3 -pady 3
grid $filter.cb1 - -sticky w -padx 3 -pady 3
grid columnconfigure $filter 1 -weight 1
|
︙ | | | ︙ | |