|
1
|
# Various diff commands ("fossil diff", "fossil stash diff", "fossil fdiff", |
|
2
|
# "fossil patch diff", and others) that include the --tk option, or that use "gdiff" |
|
3
|
# instead of diff, work by running a Tcl/Tk script which is just this script prepended |
|
4
|
# with some variable initializations. The key variable is fossilcmd which is |
|
5
|
# usually set something like this: |
|
6
|
# |
|
7
|
# set fossilcmd {| "./fossil" diff --tcl -i -v} |
|
8
|
# |
|
9
|
# If there are additional command-line options or arguments, those will be appended |
|
10
|
# as well. This variable becomes the argument to "open" to gather the diff |
|
11
|
# information that is to be displayed. |
|
12
|
# |
|
13
|
# Other variables initializations that might be prepended to this script include: |
|
14
|
# |
|
15
|
# set debug 1 |
|
16
|
# set darkmode 1 |
|
17
|
# set remotehost hostname |
|
18
|
# set remotedir directory-on-hostname |
|
19
|
# |
|
20
|
# After prepending those "set" commands, the resulting script is run using "tclsh". |
|
21
|
# |
|
22
|
# This header comment is stripped off by the "mkbuiltin.c" program. |
|
23
|
# |
|
24
|
set prog { |
|
25
|
package require Tk |
|
26
|
|
|
27
|
array set CFG_light { |
|
28
|
TITLE {Fossil Diff} |
|
29
|
LN_COL_BG #dddddd |
|
30
|
LN_COL_FG #444444 |
|
31
|
TXT_COL_BG #ffffff |
|
32
|
TXT_COL_FG #000000 |
|
33
|
MKR_COL_BG #444444 |
|
34
|
MKR_COL_FG #dddddd |
|
35
|
CHNG_BG #d0d0ff |
|
36
|
ADD_BG #c0ffc0 |
|
37
|
RM_BG #ffc0c0 |
|
38
|
HR_FG #444444 |
|
39
|
HR_PAD_TOP 4 |
|
40
|
HR_PAD_BTM 8 |
|
41
|
FN_BG #444444 |
|
42
|
FN_FG #ffffff |
|
43
|
FN_PAD 5 |
|
44
|
ERR_FG #ee0000 |
|
45
|
PADX 5 |
|
46
|
WIDTH 80 |
|
47
|
HEIGHT 45 |
|
48
|
LB_HEIGHT 25 |
|
49
|
} |
|
50
|
|
|
51
|
array set CFG_dark { |
|
52
|
TITLE {Fossil Diff} |
|
53
|
LN_COL_BG #dddddd |
|
54
|
LN_COL_FG #444444 |
|
55
|
TXT_COL_BG #3f3f3f |
|
56
|
TXT_COL_FG #dcdccc |
|
57
|
MKR_COL_BG #444444 |
|
58
|
MKR_COL_FG #dddddd |
|
59
|
CHNG_BG #6a6afc |
|
60
|
ADD_BG #57934c |
|
61
|
RM_BG #ef6767 |
|
62
|
HR_FG #444444 |
|
63
|
HR_PAD_TOP 4 |
|
64
|
HR_PAD_BTM 8 |
|
65
|
FN_BG #5e5e5e |
|
66
|
FN_FG #ffffff |
|
67
|
FN_PAD 5 |
|
68
|
ERR_FG #ee0000 |
|
69
|
PADX 5 |
|
70
|
WIDTH 80 |
|
71
|
HEIGHT 45 |
|
72
|
LB_HEIGHT 25 |
|
73
|
} |
|
74
|
|
|
75
|
array set CFG_arr { |
|
76
|
0 CFG_light |
|
77
|
1 CFG_dark |
|
78
|
} |
|
79
|
|
|
80
|
array set CFG [array get $CFG_arr($darkmode)] |
|
81
|
|
|
82
|
if {![namespace exists ttk]} { |
|
83
|
interp alias {} ::ttk::scrollbar {} ::scrollbar |
|
84
|
interp alias {} ::ttk::menubutton {} ::menubutton |
|
85
|
} |
|
86
|
|
|
87
|
proc dehtml {x} { |
|
88
|
set x [regsub -all {<[^>]*>} $x {}] |
|
89
|
return [string map {& & < < > > ' ' " \"} $x] |
|
90
|
} |
|
91
|
|
|
92
|
proc cols {} { |
|
93
|
return [list .lnA .txtA .mkr .lnB .txtB] |
|
94
|
} |
|
95
|
|
|
96
|
proc colType {c} { |
|
97
|
regexp {[a-z]+} $c type |
|
98
|
return $type |
|
99
|
} |
|
100
|
|
|
101
|
proc getLine {difftxt N iivar} { |
|
102
|
upvar $iivar ii |
|
103
|
if {$ii>=$N} {return -1} |
|
104
|
set x [lindex $difftxt $ii] |
|
105
|
incr ii |
|
106
|
return $x |
|
107
|
} |
|
108
|
|
|
109
|
proc reloadDiff {} { |
|
110
|
global fossilcmd difftxt |
|
111
|
unset -nocomplain difftxt |
|
112
|
set idx [.txtA index @0,0] |
|
113
|
readDiffs 1 |
|
114
|
update |
|
115
|
viewDiff $idx |
|
116
|
} |
|
117
|
|
|
118
|
# Populate the difftxt global variable by running the fossilcmd command |
|
119
|
# and capturing the output. This is a reload if $redo is 1 and the initial |
|
120
|
# load if $redo is 0. |
|
121
|
# |
|
122
|
proc fetchRawDiff {redo} { |
|
123
|
global fossilcmd remotehost remotedir debug difftxt |
|
124
|
if {![info exists remotehost] || $remotehost eq ""} { |
|
125
|
if {$debug} { |
|
126
|
puts "# [lrange $fossilcmd 1 end]" |
|
127
|
flush stdout |
|
128
|
} |
|
129
|
if {[catch { |
|
130
|
set in [open $fossilcmd r] |
|
131
|
fconfigure $in -encoding utf-8 |
|
132
|
set difftxt [split [read $in] \n] |
|
133
|
close $in |
|
134
|
} msg]} { |
|
135
|
if {$redo} { |
|
136
|
tk_messageBox -type ok -title Error -message "Unable to refresh:\n$msg" |
|
137
|
return 0 |
|
138
|
} else { |
|
139
|
puts $msg |
|
140
|
exit 1 |
|
141
|
} |
|
142
|
} |
|
143
|
return 0 |
|
144
|
} else { |
|
145
|
set suffix [lrange $fossilcmd 2 end] |
|
146
|
set cmd "| ssh $remotehost {cd $remotedir && fossil $suffix}" |
|
147
|
if {$debug} { |
|
148
|
puts "# [lrange $cmd 1 end]" |
|
149
|
flush stdout |
|
150
|
} |
|
151
|
if {![catch { |
|
152
|
set in [open $cmd r] |
|
153
|
fconfigure $in -encoding utf-8 |
|
154
|
set difftxt [split [read $in] \n] |
|
155
|
close $in |
|
156
|
}]} { |
|
157
|
return 1 |
|
158
|
} |
|
159
|
set cmd "| ssh $remotehost {cd $remotedir && \ |
|
160
|
PATH=\$HOME/bin:/usr/local/bin:/opt/homebrew/bin:\$PATH fossil $suffix}" |
|
161
|
if {$debug} { |
|
162
|
puts "# [lrange $cmd 1 end]" |
|
163
|
flush stdout |
|
164
|
} |
|
165
|
if {![catch { |
|
166
|
set in [open $cmd r] |
|
167
|
fconfigure $in -encoding utf-8 |
|
168
|
set difftxt [split [read $in] \n] |
|
169
|
close $in |
|
170
|
} msg]} { |
|
171
|
return 1 |
|
172
|
} |
|
173
|
if {$redo} { |
|
174
|
tk_messageBox -type ok -title Error -message "Unable to refresh:\n$msg" |
|
175
|
return 0 |
|
176
|
} else { |
|
177
|
puts $msg |
|
178
|
exit 1 |
|
179
|
} |
|
180
|
} |
|
181
|
} |
|
182
|
|
|
183
|
proc readDiffs {redo} { |
|
184
|
global fossilcmd difftxt debug |
|
185
|
if {![info exists difftxt]} { |
|
186
|
fetchRawDiff $redo |
|
187
|
} |
|
188
|
set N [llength $difftxt] |
|
189
|
set ii 0 |
|
190
|
set nDiffs 0 |
|
191
|
set n1 0 |
|
192
|
set n2 0 |
|
193
|
array set widths {txt 3 ln 3 mkr 1} |
|
194
|
if {$redo} { |
|
195
|
foreach c [cols] {$c config -state normal} |
|
196
|
.lnA delete 1.0 end |
|
197
|
.txtA delete 1.0 end |
|
198
|
.lnB delete 1.0 end |
|
199
|
.txtB delete 1.0 end |
|
200
|
.mkr delete 1.0 end |
|
201
|
.wfiles.lb delete 0 end |
|
202
|
} |
|
203
|
|
|
204
|
|
|
205
|
set fromIndex [lsearch -glob $fossilcmd *-from] |
|
206
|
set toIndex [lsearch -glob $fossilcmd *-to] |
|
207
|
set branchIndex [lsearch -glob $fossilcmd *-branch] |
|
208
|
set checkinIndex [lsearch -glob $fossilcmd *-checkin] |
|
209
|
if {[lsearch -glob $fossilcmd *-label]>=0 |
|
210
|
|| [lsearch {xdiff fdiff merge-info} [lindex $fossilcmd 2]]>=0 |
|
211
|
} { |
|
212
|
set fA {} |
|
213
|
set fB {} |
|
214
|
} else { |
|
215
|
if {[string match *?--external-baseline* $fossilcmd]} { |
|
216
|
set fA {external baseline} |
|
217
|
} else { |
|
218
|
set fA {base check-in} |
|
219
|
} |
|
220
|
set fB {current check-out} |
|
221
|
if {$fromIndex > -1} { |
|
222
|
set fA [lindex $fossilcmd $fromIndex+1] |
|
223
|
} |
|
224
|
if {$toIndex > -1} { |
|
225
|
set fB [lindex $fossilcmd $toIndex+1] |
|
226
|
} |
|
227
|
if {$branchIndex > -1} { |
|
228
|
set fA "branch point"; set fB "leaf of branch '[lindex $fossilcmd $branchIndex+1]'" |
|
229
|
} |
|
230
|
if {$checkinIndex > -1} { |
|
231
|
set fA "primary parent"; set fB [lindex $fossilcmd $checkinIndex+1] |
|
232
|
} |
|
233
|
} |
|
234
|
|
|
235
|
while {[set line [getLine $difftxt $N ii]] != -1} { |
|
236
|
switch -- [lindex $line 0] { |
|
237
|
FILE { |
|
238
|
incr nDiffs |
|
239
|
foreach wx [list [string length $n1] [string length $n2]] { |
|
240
|
if {$wx>$widths(ln)} {set widths(ln) $wx} |
|
241
|
} |
|
242
|
.lnA insert end \n fn \n - |
|
243
|
if {$fA==""} { |
|
244
|
.txtA insert end "[lindex $line 1]\n" fn \n - |
|
245
|
} else { |
|
246
|
.txtA insert end "[lindex $line 1] ($fA)\n" fn \n - |
|
247
|
} |
|
248
|
.mkr insert end \n fn \n - |
|
249
|
.lnB insert end \n fn \n - |
|
250
|
if {$fB==""} { |
|
251
|
.txtB insert end "[lindex $line 2]\n" fn \n - |
|
252
|
} else { |
|
253
|
.txtB insert end "[lindex $line 2] ($fB)\n" fn \n - |
|
254
|
} |
|
255
|
.wfiles.lb insert end [lindex $line 2] |
|
256
|
set n1 0 |
|
257
|
set n2 0 |
|
258
|
} |
|
259
|
SKIP { |
|
260
|
set n [lindex $line 1] |
|
261
|
incr n1 $n |
|
262
|
incr n2 $n |
|
263
|
.lnA insert end ...\n hrln |
|
264
|
.txtA insert end [string repeat . 30]\n hrtxt |
|
265
|
.mkr insert end \n hrln |
|
266
|
.lnB insert end ...\n hrln |
|
267
|
.txtB insert end [string repeat . 30]\n hrtxt |
|
268
|
} |
|
269
|
COM { |
|
270
|
set x [lindex $line 1] |
|
271
|
incr n1 |
|
272
|
incr n2 |
|
273
|
.lnA insert end $n1\n - |
|
274
|
.txtA insert end $x\n - |
|
275
|
.mkr insert end \n - |
|
276
|
.lnB insert end $n2\n - |
|
277
|
.txtB insert end $x\n - |
|
278
|
} |
|
279
|
INS { |
|
280
|
set x [lindex $line 1] |
|
281
|
incr n2 |
|
282
|
.lnA insert end \n - |
|
283
|
.txtA insert end \n - |
|
284
|
.mkr insert end >\n - |
|
285
|
.lnB insert end $n2\n - |
|
286
|
.txtB insert end $x add \n - |
|
287
|
} |
|
288
|
DEL { |
|
289
|
set x [lindex $line 1] |
|
290
|
incr n1 |
|
291
|
.lnA insert end $n1\n - |
|
292
|
.txtA insert end $x rm \n - |
|
293
|
.mkr insert end <\n - |
|
294
|
.lnB insert end \n - |
|
295
|
.txtB insert end \n - |
|
296
|
} |
|
297
|
EDIT { |
|
298
|
incr n1 |
|
299
|
incr n2 |
|
300
|
.lnA insert end $n1\n - |
|
301
|
.lnB insert end $n2\n - |
|
302
|
.mkr insert end |\n - |
|
303
|
set nn [llength $line] |
|
304
|
for {set i 1} {$i<$nn} {incr i 3} { |
|
305
|
set x [lindex $line $i] |
|
306
|
if {$x ne ""} { |
|
307
|
.txtA insert end $x - |
|
308
|
.txtB insert end $x - |
|
309
|
} |
|
310
|
if {$i+2<$nn} { |
|
311
|
set x1 [lindex $line [expr {$i+1}]] |
|
312
|
set x2 [lindex $line [expr {$i+2}]] |
|
313
|
if {"$x1" eq ""} { |
|
314
|
.txtB insert end $x2 add |
|
315
|
} elseif {"$x2" eq ""} { |
|
316
|
.txtA insert end $x1 rm |
|
317
|
} else { |
|
318
|
.txtA insert end $x1 chng |
|
319
|
.txtB insert end $x2 chng |
|
320
|
} |
|
321
|
} |
|
322
|
} |
|
323
|
.txtA insert end \n - |
|
324
|
.txtB insert end \n - |
|
325
|
} |
|
326
|
"" { |
|
327
|
foreach wx [list [string length $n1] [string length $n2]] { |
|
328
|
if {$wx>$widths(ln)} {set widths(ln) $wx} |
|
329
|
} |
|
330
|
} |
|
331
|
default { |
|
332
|
.lnA insert end \n - |
|
333
|
.txtA insert end $line\n err |
|
334
|
.mkr insert end \n - |
|
335
|
.lnB insert end \n - |
|
336
|
.txtB insert end $line\n err |
|
337
|
} |
|
338
|
} |
|
339
|
} |
|
340
|
|
|
341
|
foreach c [cols] { |
|
342
|
set type [colType $c] |
|
343
|
if {$type ne "txt"} { |
|
344
|
$c config -width $widths($type) |
|
345
|
} |
|
346
|
$c config -state disabled |
|
347
|
} |
|
348
|
.wfiles.lb config -height $nDiffs |
|
349
|
if {$nDiffs <= [.wfiles.lb cget -height]} { |
|
350
|
grid remove .wfiles.sb |
|
351
|
} |
|
352
|
|
|
353
|
return $nDiffs |
|
354
|
} |
|
355
|
|
|
356
|
proc viewDiff {idx} { |
|
357
|
.txtA yview $idx |
|
358
|
.txtA xview moveto 0 |
|
359
|
} |
|
360
|
|
|
361
|
proc cycleDiffs {{reverse 0}} { |
|
362
|
if {$reverse} { |
|
363
|
set range [.txtA tag prevrange fn @0,0 1.0] |
|
364
|
if {$range eq ""} { |
|
365
|
viewDiff {fn.last -1c} |
|
366
|
} else { |
|
367
|
viewDiff [lindex $range 0] |
|
368
|
} |
|
369
|
} else { |
|
370
|
set range [.txtA tag nextrange fn {@0,0 +1c} end] |
|
371
|
if {$range eq "" || [lindex [.txtA yview] 1] == 1} { |
|
372
|
viewDiff fn.first |
|
373
|
} else { |
|
374
|
viewDiff [lindex $range 0] |
|
375
|
} |
|
376
|
} |
|
377
|
} |
|
378
|
|
|
379
|
proc xvis {col} { |
|
380
|
set view [$col xview] |
|
381
|
return [expr {[lindex $view 1]-[lindex $view 0]}] |
|
382
|
} |
|
383
|
|
|
384
|
proc scroll-x {args} { |
|
385
|
set c .txt[expr {[xvis .txtA] < [xvis .txtB] ? "A" : "B"}] |
|
386
|
eval $c xview $args |
|
387
|
} |
|
388
|
|
|
389
|
interp alias {} scroll-y {} .txtA yview |
|
390
|
|
|
391
|
proc noop {args} {} |
|
392
|
|
|
393
|
proc enableSync {axis} { |
|
394
|
update idletasks |
|
395
|
interp alias {} sync-$axis {} |
|
396
|
rename _sync-$axis sync-$axis |
|
397
|
} |
|
398
|
|
|
399
|
proc disableSync {axis} { |
|
400
|
rename sync-$axis _sync-$axis |
|
401
|
interp alias {} sync-$axis {} noop |
|
402
|
} |
|
403
|
|
|
404
|
proc sync-x {col first last} { |
|
405
|
disableSync x |
|
406
|
$col xview moveto [expr {$first*[xvis $col]/($last-$first)}] |
|
407
|
foreach side {A B} { |
|
408
|
set sb .sbx$side |
|
409
|
set xview [.txt$side xview] |
|
410
|
if {[lindex $xview 0] > 0 || [lindex $xview 1] < 1} { |
|
411
|
grid $sb |
|
412
|
eval $sb set $xview |
|
413
|
} else { |
|
414
|
grid remove $sb |
|
415
|
} |
|
416
|
} |
|
417
|
enableSync x |
|
418
|
} |
|
419
|
|
|
420
|
proc sync-y {first last} { |
|
421
|
disableSync y |
|
422
|
foreach c [cols] { |
|
423
|
$c yview moveto $first |
|
424
|
} |
|
425
|
if {$first > 0 || $last < 1} { |
|
426
|
grid .sby |
|
427
|
.sby set $first $last |
|
428
|
} else { |
|
429
|
grid remove .sby |
|
430
|
} |
|
431
|
enableSync y |
|
432
|
} |
|
433
|
|
|
434
|
wm withdraw . |
|
435
|
wm title . $CFG(TITLE) |
|
436
|
wm iconname . $CFG(TITLE) |
|
437
|
# Keystroke bindings for on the top-level window for navigation and |
|
438
|
# control also fire when those same keystrokes are pressed in the |
|
439
|
# Search entry box. Disable them, to prevent the diff screen from |
|
440
|
# disappearing abruptly and unexpectedly when searching for "q". |
|
441
|
# |
|
442
|
bind . <Control-q> exit |
|
443
|
bind . <Control-p> {catch searchPrev; break} |
|
444
|
bind . <Control-n> {catch searchNext; break} |
|
445
|
bind . <Escape><Escape> exit |
|
446
|
bind . <Destroy> {after 0 exit} |
|
447
|
bind . <Tab> {cycleDiffs; break} |
|
448
|
bind . <<PrevWindow>> {cycleDiffs 1; break} |
|
449
|
bind . <Control-f> {searchOnOff; break} |
|
450
|
bind . <Control-g> {catch searchNext; break} |
|
451
|
bind . <Return> { |
|
452
|
event generate .bb.files <1> |
|
453
|
event generate .bb.files <ButtonRelease-1> |
|
454
|
break |
|
455
|
} |
|
456
|
foreach {key axis args} { |
|
457
|
Up y {scroll -5 units} |
|
458
|
k y {scroll -5 units} |
|
459
|
Down y {scroll 5 units} |
|
460
|
j y {scroll 5 units} |
|
461
|
Left x {scroll -5 units} |
|
462
|
h x {scroll -5 units} |
|
463
|
Right x {scroll 5 units} |
|
464
|
l x {scroll 5 units} |
|
465
|
Prior y {scroll -1 page} |
|
466
|
b y {scroll -1 page} |
|
467
|
Next y {scroll 1 page} |
|
468
|
space y {scroll 1 page} |
|
469
|
Home y {moveto 0} |
|
470
|
g y {moveto 0} |
|
471
|
End y {moveto 1} |
|
472
|
} { |
|
473
|
bind . <$key> "scroll-$axis $args; break" |
|
474
|
bind . <Shift-$key> continue |
|
475
|
} |
|
476
|
|
|
477
|
frame .bb |
|
478
|
::ttk::menubutton .bb.files -text "Files" |
|
479
|
if {[tk windowingsystem] eq "win32"} { |
|
480
|
::ttk::style theme use winnative |
|
481
|
.bb.files configure -padding {20 1 10 2} |
|
482
|
} |
|
483
|
toplevel .wfiles |
|
484
|
wm withdraw .wfiles |
|
485
|
update idletasks |
|
486
|
wm transient .wfiles . |
|
487
|
wm overrideredirect .wfiles 1 |
|
488
|
listbox .wfiles.lb -width 0 -height $CFG(LB_HEIGHT) -activestyle none \ |
|
489
|
-yscroll {.wfiles.sb set} |
|
490
|
::ttk::scrollbar .wfiles.sb -command {.wfiles.lb yview} |
|
491
|
grid .wfiles.lb .wfiles.sb -sticky ns |
|
492
|
bind .bb.files <1> { |
|
493
|
set x [winfo rootx %W] |
|
494
|
set y [expr {[winfo rooty %W]+[winfo height %W]}] |
|
495
|
wm geometry .wfiles +$x+$y |
|
496
|
wm deiconify .wfiles |
|
497
|
focus .wfiles.lb |
|
498
|
} |
|
499
|
bind .wfiles <FocusOut> {wm withdraw .wfiles} |
|
500
|
bind .wfiles <Escape> {focus .} |
|
501
|
foreach evt {1 Return} { |
|
502
|
bind .wfiles.lb <$evt> { |
|
503
|
catch { |
|
504
|
set idx [lindex [.txtA tag ranges fn] [expr {[%W curselection]*2}]] |
|
505
|
viewDiff $idx |
|
506
|
} |
|
507
|
focus . |
|
508
|
break |
|
509
|
} |
|
510
|
} |
|
511
|
bind .wfiles.lb <Motion> { |
|
512
|
%W selection clear 0 end |
|
513
|
%W selection set @%x,%y |
|
514
|
} |
|
515
|
|
|
516
|
foreach {side syncCol} {A .txtB B .txtA} { |
|
517
|
set ln .ln$side |
|
518
|
text $ln |
|
519
|
$ln tag config - -justify right |
|
520
|
|
|
521
|
set txt .txt$side |
|
522
|
text $txt -width $CFG(WIDTH) -height $CFG(HEIGHT) -wrap none \ |
|
523
|
-xscroll "sync-x $syncCol" |
|
524
|
catch {$txt config -tabstyle wordprocessor} ;# Required for Tk>=8.5 |
|
525
|
foreach tag {add rm chng} { |
|
526
|
$txt tag config $tag -background $CFG([string toupper $tag]_BG) |
|
527
|
$txt tag lower $tag |
|
528
|
} |
|
529
|
$txt tag config fn -background $CFG(FN_BG) -foreground $CFG(FN_FG) \ |
|
530
|
-justify center |
|
531
|
$txt tag config err -foreground $CFG(ERR_FG) |
|
532
|
} |
|
533
|
text .mkr |
|
534
|
|
|
535
|
foreach c [cols] { |
|
536
|
set keyPrefix [string toupper [colType $c]]_COL_ |
|
537
|
if {[tk windowingsystem] eq "win32"} {$c config -font {courier 9}} |
|
538
|
$c config -bg $CFG(${keyPrefix}BG) -fg $CFG(${keyPrefix}FG) -borderwidth 0 \ |
|
539
|
-padx $CFG(PADX) -yscroll sync-y |
|
540
|
$c tag config hrln -spacing1 $CFG(HR_PAD_TOP) -spacing3 $CFG(HR_PAD_BTM) \ |
|
541
|
-foreground $CFG(HR_FG) -justify right |
|
542
|
$c tag config hrtxt -spacing1 $CFG(HR_PAD_TOP) -spacing3 $CFG(HR_PAD_BTM) \ |
|
543
|
-foreground $CFG(HR_FG) -justify center |
|
544
|
$c tag config fn -spacing1 $CFG(FN_PAD) -spacing3 $CFG(FN_PAD) |
|
545
|
bindtags $c ". $c Text all" |
|
546
|
bind $c <1> {focus %W} |
|
547
|
} |
|
548
|
|
|
549
|
::ttk::scrollbar .sby -command {.txtA yview} -orient vertical |
|
550
|
::ttk::scrollbar .sbxA -command {.txtA xview} -orient horizontal |
|
551
|
::ttk::scrollbar .sbxB -command {.txtB xview} -orient horizontal |
|
552
|
frame .spacer |
|
553
|
|
|
554
|
if {[readDiffs 0] == 0} { |
|
555
|
tk_messageBox -type ok -title $CFG(TITLE) -message "No changes" |
|
556
|
exit |
|
557
|
} |
|
558
|
update idletasks |
|
559
|
|
|
560
|
proc saveDiff {} { |
|
561
|
set fn [tk_getSaveFile] |
|
562
|
if {$fn==""} return |
|
563
|
set out [open $fn wb] |
|
564
|
puts $out "#!/usr/bin/tclsh\n#\n# Run this script using 'tclsh' or 'wish'" |
|
565
|
puts $out "# to see the graphical diff.\n#" |
|
566
|
puts $out "set fossilcmd {}" |
|
567
|
puts $out "set darkmode $::darkmode" |
|
568
|
puts $out "set debug $::debug" |
|
569
|
puts $out "set prog [list $::prog]" |
|
570
|
puts $out "set difftxt \173" |
|
571
|
foreach e $::difftxt {puts $out [list $e]} |
|
572
|
puts $out "\175" |
|
573
|
puts $out "eval \$prog" |
|
574
|
close $out |
|
575
|
} |
|
576
|
proc invertDiff {} { |
|
577
|
global CFG |
|
578
|
array set x [grid info .txtA] |
|
579
|
if {$x(-column)==1} { |
|
580
|
grid config .lnB -column 0 |
|
581
|
grid config .txtB -column 1 |
|
582
|
.txtB tag config add -background $CFG(RM_BG) |
|
583
|
grid config .lnA -column 3 |
|
584
|
grid config .txtA -column 4 |
|
585
|
.txtA tag config rm -background $CFG(ADD_BG) |
|
586
|
.bb.invert config -text Uninvert |
|
587
|
} else { |
|
588
|
grid config .lnA -column 0 |
|
589
|
grid config .txtA -column 1 |
|
590
|
.txtA tag config rm -background $CFG(RM_BG) |
|
591
|
grid config .lnB -column 3 |
|
592
|
grid config .txtB -column 4 |
|
593
|
.txtB tag config add -background $CFG(ADD_BG) |
|
594
|
.bb.invert config -text Invert |
|
595
|
} |
|
596
|
.mkr config -state normal |
|
597
|
set clt [.mkr search -all < 1.0 end] |
|
598
|
set cgt [.mkr search -all > 1.0 end] |
|
599
|
foreach c $clt {.mkr replace $c "$c +1 chars" >} |
|
600
|
foreach c $cgt {.mkr replace $c "$c +1 chars" <} |
|
601
|
.mkr config -state disabled |
|
602
|
} |
|
603
|
proc searchOnOff {} { |
|
604
|
if {[info exists ::search]} { |
|
605
|
unset ::search |
|
606
|
.txtA tag remove search 1.0 end |
|
607
|
.txtB tag remove search 1.0 end |
|
608
|
pack forget .bb.sframe |
|
609
|
focus . |
|
610
|
} else { |
|
611
|
set ::search .txtA |
|
612
|
if {![winfo exists .bb.sframe]} { |
|
613
|
frame .bb.sframe |
|
614
|
::ttk::entry .bb.sframe.e -width 10 |
|
615
|
pack .bb.sframe.e -side left -fill y -expand 1 |
|
616
|
bind .bb.sframe.e <Return> {searchNext; break} |
|
617
|
::ttk::button .bb.sframe.nx -text \u2193 -width 1 -command searchNext |
|
618
|
::ttk::button .bb.sframe.pv -text \u2191 -width 1 -command searchPrev |
|
619
|
tk_optionMenu .bb.sframe.typ ::search_type \ |
|
620
|
Exact {No Case} {RegExp} {Whole Word} |
|
621
|
.bb.sframe.typ config -width 10 |
|
622
|
set ::search_type Exact |
|
623
|
pack .bb.sframe.nx .bb.sframe.pv .bb.sframe.typ -side left |
|
624
|
} |
|
625
|
pack .bb.sframe -side left |
|
626
|
after idle {focus .bb.sframe.e} |
|
627
|
} |
|
628
|
} |
|
629
|
proc searchNext {} {searchStep -forwards +1 1.0 end} |
|
630
|
proc searchPrev {} {searchStep -backwards -1 end 1.0} |
|
631
|
proc searchStep {direction incr start stop} { |
|
632
|
set pattern [.bb.sframe.e get] |
|
633
|
if {$pattern==""} return |
|
634
|
set count 0 |
|
635
|
set w $::search |
|
636
|
if {"$w"==".txtA"} {set other .txtB} {set other .txtA} |
|
637
|
if {[lsearch [$w mark names] search]<0} { |
|
638
|
$w mark set search $start |
|
639
|
} |
|
640
|
switch $::search_type { |
|
641
|
Exact {set st -exact} |
|
642
|
{No Case} {set st -nocase} |
|
643
|
{RegExp} {set st -regexp} |
|
644
|
{Whole Word} {set st -regexp; set pattern \\y$pattern\\y} |
|
645
|
} |
|
646
|
set idx [$w search -count count $direction $st -- \ |
|
647
|
$pattern "search $incr chars" $stop] |
|
648
|
if {"$idx"==""} { |
|
649
|
set idx [$other search -count count $direction $st -- $pattern $start $stop] |
|
650
|
if {"$idx"!=""} { |
|
651
|
set this $w |
|
652
|
set w $other |
|
653
|
set other $this |
|
654
|
} else { |
|
655
|
set idx [$w search -count count $direction $st -- $pattern $start $stop] |
|
656
|
} |
|
657
|
} |
|
658
|
$w tag remove search 1.0 end |
|
659
|
$w mark unset search |
|
660
|
$other tag remove search 1.0 end |
|
661
|
$other mark unset search |
|
662
|
if {"$idx"!=""} { |
|
663
|
$w mark set search $idx |
|
664
|
$w yview -pickplace $idx |
|
665
|
$w tag add search search "$idx +$count chars" |
|
666
|
$w tag config search -background {#fcc000} |
|
667
|
} |
|
668
|
set ::search $w |
|
669
|
} |
|
670
|
::ttk::button .bb.quit -text {Quit} -command exit |
|
671
|
::ttk::button .bb.reload -text {Reload} -command reloadDiff |
|
672
|
::ttk::button .bb.invert -text {Invert} -command invertDiff |
|
673
|
::ttk::button .bb.save -text {Save As...} -command saveDiff |
|
674
|
::ttk::button .bb.search -text {Search} -command searchOnOff |
|
675
|
pack .bb.quit -side left |
|
676
|
if {$fossilcmd ne ""} { |
|
677
|
pack .bb.reload -side left |
|
678
|
} |
|
679
|
pack .bb.invert -side left |
|
680
|
if {$fossilcmd!=""} {pack .bb.save -side left} |
|
681
|
pack .bb.files .bb.search -side left |
|
682
|
grid rowconfigure . 1 -weight 1 |
|
683
|
grid columnconfigure . 1 -weight 1 |
|
684
|
grid columnconfigure . 4 -weight 1 |
|
685
|
grid .bb -row 0 -columnspan 6 |
|
686
|
eval grid [cols] -row 1 -sticky nsew |
|
687
|
grid .sby -row 1 -column 5 -sticky ns |
|
688
|
grid .sbxA -row 2 -columnspan 2 -sticky ew |
|
689
|
grid .spacer -row 2 -column 2 |
|
690
|
grid .sbxB -row 2 -column 3 -columnspan 2 -sticky ew |
|
691
|
|
|
692
|
.spacer config -height [winfo height .sbxA] |
|
693
|
|
|
694
|
set h [winfo screenheight .] |
|
695
|
if {$h > 1280} { |
|
696
|
set w [winfo screenwidth .]; # [winfo width] == 32 |
|
697
|
if {$w > 2048} { |
|
698
|
set w 2048 |
|
699
|
} |
|
700
|
set g [expr {$w / 3 * 2}]x[expr {$h / 4 * 3}] |
|
701
|
wm geometry . $g |
|
702
|
} |
|
703
|
|
|
704
|
wm deiconify . |
|
705
|
|
|
706
|
} |
|
707
|
eval $prog |
|
708
|
|