Fossil SCM

fossil-scm / src / merge.tcl
Blame History Raw 643 lines
1
# Show details of a 3-way merge operation. The left-most column is the
2
# common ancestor. The next two columns are edits of that common ancestor.
3
# The right-most column is the result of the merge.
4
#
5
# Several variables will have been initialized:
6
#
7
# ncontext The number of lines of context to show on each change
8
#
9
# fossilexe Pathname of the fossil program
10
#
11
# filelist A list of "merge-type filename" pairs.
12
#
13
# darkmode Boolean. True for dark mode
14
#
15
# debug Boolean. True for debugging output
16
#
17
# If the "filelist" global variable is defined, then it is a list of
18
# alternating "merge-type names" (ex: UPDATE, MERGE, CONFLICT, ERROR) and
19
# filenames. In that case, the initial display shows the changes for
20
# the first pair on the list and there is a optionmenu that allows the
21
# user to select other fiels on the list.
22
#
23
# This header comment is stripped off by the "mkbuiltin.c" program.
24
#
25
package require Tk
26
27
array set CFG_light {
28
TITLE {Fossil Merge}
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 #d0d070
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 Merge}
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 #6a6a00
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 {&amp; & &lt; < &gt; > &#39; ' &quot; \"} $x]
90
}
91
92
proc cols {} {
93
return [list .lnA .txtA .lnB .txtB .lnC .txtC .lnD .txtD]
94
}
95
96
proc colType {c} {
97
regexp {[a-z]+} $c type
98
return $type
99
}
100
101
proc readMerge {args} {
102
global fossilexe ncontext current_file debug
103
if {$ncontext=="All"} {
104
set cmd "| $fossilexe merge-info -c -1"
105
} else {
106
set cmd "| $fossilexe merge-info -c $ncontext"
107
}
108
if {[info exists current_file]} {
109
regsub {^[A-Z]+ } $current_file {} fn
110
lappend cmd -tcl $fn
111
}
112
if {$debug} {
113
regsub {^\| +} $cmd {} cmd2
114
puts $cmd2
115
flush stdout
116
}
117
if {[catch {
118
set in [open $cmd r]
119
fconfigure $in -encoding utf-8
120
set mergetxt [read $in]
121
close $in
122
} msg]} {
123
tk_messageBox -message "Unable to run command: \"$cmd\""
124
set mergetxt {}
125
}
126
foreach c [cols] {
127
$c config -state normal
128
$c delete 1.0 end
129
}
130
set lnA 1
131
set lnB 1
132
set lnC 1
133
set lnD 1
134
foreach {A B C D} $mergetxt {
135
set key1 [string index $A 0]
136
if {$key1=="S"} {
137
scan [string range $A 1 end] "%d %d %d %d" nA nB nC nD
138
foreach x {A B C D} {
139
set N [set n$x]
140
incr ln$x $N
141
if {$N>0} {
142
.ln$x insert end ...\n hrln
143
.txt$x insert end [string repeat . 30]\n hrtxt
144
} else {
145
.ln$x insert end \n hrln
146
.txt$x insert end \n hrtxt
147
}
148
}
149
continue
150
}
151
set key2 [string index $B 0]
152
set key3 [string index $C 0]
153
set key4 [string index $D 0]
154
if {$key1=="."} {
155
.lnA insert end \n -
156
.txtA insert end \n -
157
} elseif {$key1=="N"} {
158
.nameA config -text [string range $A 1 end]
159
} else {
160
.lnA insert end $lnA\n -
161
incr lnA
162
if {$key1=="X"} {
163
.txtA insert end [string range $A 1 end]\n rm
164
} else {
165
.txtA insert end [string range $A 1 end]\n -
166
}
167
}
168
if {$key2=="."} {
169
.lnB insert end \n -
170
.txtB insert end \n -
171
} elseif {$key2=="N"} {
172
.nameB config -text [string range $B 1 end]
173
} else {
174
.lnB insert end $lnB\n -
175
incr lnB
176
if {$key4=="2"} {set tag chng} {set tag -}
177
if {$key2=="1"} {
178
.txtB insert end [string range $A 1 end]\n $tag
179
} elseif {$key2=="X"} {
180
.txtB insert end [string range $B 1 end]\n rm
181
} else {
182
.txtB insert end [string range $B 1 end]\n $tag
183
}
184
}
185
if {$key3=="."} {
186
.lnC insert end \n -
187
.txtC insert end \n -
188
} elseif {$key3=="N"} {
189
.nameC config -text [string range $C 1 end]
190
} else {
191
.lnC insert end $lnC\n -
192
incr lnC
193
if {$key4=="3"} {set tag add} {set tag -}
194
if {$key3=="1"} {
195
.txtC insert end [string range $A 1 end]\n $tag
196
} elseif {$key3=="2"} {
197
.txtC insert end [string range $B 1 end]\n chng
198
} elseif {$key3=="X"} {
199
.txtC insert end [string range $C 1 end]\n rm
200
} else {
201
.txtC insert end [string range $C 1 end]\n $tag
202
}
203
}
204
if {$key4=="."} {
205
.lnD insert end \n -
206
.txtD insert end \n -
207
} elseif {$key4=="N"} {
208
.nameD config -text [string range $D 1 end]
209
} else {
210
.lnD insert end $lnD\n -
211
incr lnD
212
if {$key4=="1"} {
213
.txtD insert end [string range $A 1 end]\n -
214
} elseif {$key4=="2"} {
215
.txtD insert end [string range $B 1 end]\n chng
216
} elseif {$key4=="3"} {
217
.txtD insert end [string range $C 1 end]\n add
218
} elseif {$key4=="X"} {
219
.txtD insert end [string range $D 1 end]\n rm
220
} else {
221
.txtD insert end [string range $D 1 end]\n -
222
}
223
}
224
}
225
foreach c [cols] {
226
set type [colType $c]
227
if {$type ne "txt"} {
228
$c config -width 6; # $widths($type)
229
}
230
$c config -state disabled
231
}
232
set mx $lnA
233
if {$lnB>$mx} {set mx $lnB}
234
if {$lnC>$mx} {set mx $lnC}
235
if {$lnD>$mx} {set mx $lnD}
236
global lnWidth
237
set lnWidth [string length [format +%d $mx]]
238
.lnA config -width $lnWidth
239
.lnB config -width $lnWidth
240
.lnC config -width $lnWidth
241
.lnD config -width $lnWidth
242
grid columnconfig . {0 2 4 6} -minsize $lnWidth
243
}
244
245
proc viewDiff {idx} {
246
.txtA yview $idx
247
.txtA xview moveto 0
248
}
249
250
proc cycleDiffs {{reverse 0}} {
251
if {$reverse} {
252
set range [.txtA tag prevrange fn @0,0 1.0]
253
if {$range eq ""} {
254
viewDiff {fn.last -1c}
255
} else {
256
viewDiff [lindex $range 0]
257
}
258
} else {
259
set range [.txtA tag nextrange fn {@0,0 +1c} end]
260
if {$range eq "" || [lindex [.txtA yview] 1] == 1} {
261
viewDiff fn.first
262
} else {
263
viewDiff [lindex $range 0]
264
}
265
}
266
}
267
268
proc xvis {col} {
269
set view [$col xview]
270
return [expr {[lindex $view 1]-[lindex $view 0]}]
271
}
272
273
proc scroll-x {args} {
274
set c .txt[expr {[xvis .txtA] < [xvis .txtB] ? "A" : "B"}]
275
eval $c xview $args
276
}
277
278
interp alias {} scroll-y {} .txtA yview
279
280
proc noop {args} {}
281
282
proc enableSync {axis} {
283
update idletasks
284
interp alias {} sync-$axis {}
285
rename _sync-$axis sync-$axis
286
}
287
288
proc disableSync {axis} {
289
rename sync-$axis _sync-$axis
290
interp alias {} sync-$axis {} noop
291
}
292
293
proc sync-y {first last} {
294
disableSync y
295
foreach c [cols] {
296
$c yview moveto $first
297
}
298
if {$first > 0 || $last < 1} {
299
grid .sby
300
.sby set $first $last
301
} else {
302
grid remove .sby
303
}
304
enableSync y
305
}
306
307
wm withdraw .
308
wm title . $CFG(TITLE)
309
wm iconname . $CFG(TITLE)
310
# Keystroke bindings for on the top-level window for navigation and
311
# control also fire when those same keystrokes are pressed in the
312
# Search entry box. Disable them, to prevent the diff screen from
313
# disappearing abruptly and unexpectedly when searching for "q".
314
#
315
bind . <Control-q> exit
316
bind . <Control-p> {catch searchPrev; break}
317
bind . <Control-n> {catch searchNext; break}
318
bind . <Escape><Escape> exit
319
bind . <Destroy> {after 0 exit}
320
bind . <Tab> {cycleDiffs; break}
321
bind . <<PrevWindow>> {cycleDiffs 1; break}
322
bind . <Control-f> {searchOnOff; break}
323
bind . <Control-g> {catch searchNext; break}
324
bind . <Return> {
325
event generate .bb.files <1>
326
event generate .bb.files <ButtonRelease-1>
327
break
328
}
329
foreach {key axis args} {
330
Up y {scroll -5 units}
331
k y {scroll -5 units}
332
Down y {scroll 5 units}
333
j y {scroll 5 units}
334
Left x {scroll -5 units}
335
h x {scroll -5 units}
336
Right x {scroll 5 units}
337
l x {scroll 5 units}
338
Prior y {scroll -1 page}
339
b y {scroll -1 page}
340
Next y {scroll 1 page}
341
space y {scroll 1 page}
342
Home y {moveto 0}
343
g y {moveto 0}
344
End y {moveto 1}
345
} {
346
bind . <$key> "scroll-$axis $args; break"
347
bind . <Shift-$key> continue
348
}
349
350
frame .bb
351
::ttk::menubutton .bb.diff2 -text {2-way diff} -menu .bb.diff2.m
352
menu .bb.diff2.m -tearoff 0
353
.bb.diff2.m add command -label {baseline vs. local} -command {two-way 12}
354
.bb.diff2.m add command -label {baseline vs. merge-in} -command {two-way 13}
355
.bb.diff2.m add command -label {local vs. merge-in} -command {two-way 23}
356
357
# Bring up a separate two-way diff between a pair of columns
358
# the argument is one of:
359
# 12 Baseline versus Local
360
# 13 Baseline versus Merge-in
361
# 23 Local versus Merge-in
362
#
363
proc two-way {mode} {
364
global current_file fossilexe debug darkmode ncontext
365
regsub {^[A-Z]+ } $current_file {} fn
366
set cmd $fossilexe
367
lappend cmd merge-info --diff$mode $fn -c $ncontext
368
if {$darkmode} {
369
lappend cmd --dark
370
}
371
if {$debug} {
372
lappend cmd --tkdebug
373
puts $cmd
374
flush stdout
375
}
376
exec {*}$cmd &
377
}
378
379
set useOptionMenu 1
380
if {[info exists filelist]} {
381
set current_file "[lindex $filelist 0] [lindex $filelist 1]"
382
if {[llength $filelist]>2} {
383
trace add variable current_file write readMerge
384
385
if {$tcl_platform(os)=="Darwin" || [llength $filelist]<30} {
386
set fnlist {}
387
foreach {op fn} $filelist {lappend fnlist "$op $fn"}
388
tk_optionMenu .bb.files current_file {*}$fnlist
389
} else {
390
set useOptionMenu 0
391
::ttk::menubutton .bb.files -text $current_file
392
if {[tk windowingsystem] eq "win32"} {
393
::ttk::style theme use winnative
394
.bb.files configure -padding {20 1 10 2}
395
}
396
toplevel .wfiles
397
wm withdraw .wfiles
398
update idletasks
399
wm transient .wfiles .
400
wm overrideredirect .wfiles 1
401
set ht [expr {[llength $filelist]/2}]
402
if {$ht>$CFG(LB_HEIGHT)} {set ht $CFG(LB_HEIGHT)}
403
listbox .wfiles.lb -width 0 -height $ht -activestyle none \
404
-yscroll {.wfiles.sb set}
405
set mx 1
406
foreach {op fn} $filelist {
407
set n [string length $fn]
408
if {$n>$mx} {set mx $n}
409
.wfiles.lb insert end "$op $fn"
410
}
411
.bb.files config -width $mx
412
::ttk::scrollbar .wfiles.sb -command {.wfiles.lb yview}
413
grid .wfiles.lb .wfiles.sb -sticky ns
414
bind .bb.files <1> {
415
set x [winfo rootx %W]
416
set y [expr {[winfo rooty %W]+[winfo height %W]}]
417
wm geometry .wfiles +$x+$y
418
wm deiconify .wfiles
419
focus .wfiles.lb
420
}
421
bind .wfiles <FocusOut> {wm withdraw .wfiles}
422
bind .wfiles <Escape> {focus .}
423
foreach evt {1 Return} {
424
bind .wfiles.lb <$evt> {
425
set ii [%W curselection]
426
set ::current_file [%W get $ii]
427
.bb.files config -text $::current_file
428
focus .
429
break
430
}
431
}
432
bind .wfiles.lb <Motion> {
433
%W selection clear 0 end
434
%W selection set @%x,%y
435
}
436
}
437
}
438
}
439
440
label .bb.ctxtag -text "Context:"
441
set context_choices {3 6 12 25 50 100 All}
442
if {$ncontext<0} {set ncontext All}
443
trace add variable ncontext write readMerge
444
if {$tcl_platform(os)=="Darwin" || $useOptionMenu} {
445
tk_optionMenu .bb.ctx ncontext {*}$context_choices
446
} else {
447
::ttk::menubutton .bb.ctx -text $ncontext
448
if {[tk windowingsystem] eq "win32"} {
449
::ttk::style theme use winnative
450
.bb.ctx configure -padding {20 1 10 2}
451
}
452
toplevel .wctx
453
wm withdraw .wctx
454
update idletasks
455
wm transient .wctx .
456
wm overrideredirect .wctx 1
457
listbox .wctx.lb -width 0 -height 7 -activestyle none
458
.wctx.lb insert end {*}$context_choices
459
pack .wctx.lb
460
bind .bb.ctx <1> {
461
set x [winfo rootx %W]
462
set y [expr {[winfo rooty %W]+[winfo height %W]}]
463
wm geometry .wctx +$x+$y
464
wm deiconify .wctx
465
focus .wctx.lb
466
}
467
bind .wctx <FocusOut> {wm withdraw .wctx}
468
bind .wctx <Escape> {focus .}
469
foreach evt {1 Return} {
470
bind .wctx.lb <$evt> {
471
set ::ncontext [lindex $::context_choices [%W curselection]]
472
.bb.ctx config -text $::ncontext
473
focus .
474
break
475
}
476
}
477
bind .wctx.lb <Motion> {
478
%W selection clear 0 end
479
%W selection set @%x,%y
480
}
481
}
482
483
foreach {side syncCol} {A .txtA B .txtB C .txtC D .txtD} {
484
set ln .ln$side
485
text $ln -width 6
486
$ln tag config - -justify right
487
488
set txt .txt$side
489
text $txt -width $CFG(WIDTH) -height $CFG(HEIGHT) -wrap none \
490
-xscroll ".sbx$side set"
491
catch {$txt config -tabstyle wordprocessor} ;# Required for Tk>=8.5
492
foreach tag {add rm chng} {
493
$txt tag config $tag -background $CFG([string toupper $tag]_BG)
494
$txt tag lower $tag
495
}
496
$txt tag config fn -background $CFG(FN_BG) -foreground $CFG(FN_FG) \
497
-justify center
498
$txt tag config err -foreground $CFG(ERR_FG)
499
}
500
text .mkr
501
502
set mxwidth [lindex [wm maxsize .] 0]
503
while {$CFG(WIDTH)>=40} {
504
set wanted [expr {([winfo reqwidth .lnA]+[winfo reqwidth .txtA])*4+30}]
505
if {$wanted<=$mxwidth} break
506
incr CFG(WIDTH) -10
507
.txtA config -width $CFG(WIDTH)
508
.txtB config -width $CFG(WIDTH)
509
.txtC config -width $CFG(WIDTH)
510
.txtD config -width $CFG(WIDTH)
511
}
512
513
foreach c [cols] {
514
set keyPrefix [string toupper [colType $c]]_COL_
515
if {[tk windowingsystem] eq "win32"} {$c config -font {courier 9}}
516
$c config -bg $CFG(${keyPrefix}BG) -fg $CFG(${keyPrefix}FG) -borderwidth 0 \
517
-padx $CFG(PADX) -yscroll sync-y
518
$c tag config hrln -spacing1 $CFG(HR_PAD_TOP) -spacing3 $CFG(HR_PAD_BTM) \
519
-foreground $CFG(HR_FG) -justify right
520
$c tag config hrtxt -spacing1 $CFG(HR_PAD_TOP) -spacing3 $CFG(HR_PAD_BTM) \
521
-foreground $CFG(HR_FG) -justify center
522
$c tag config fn -spacing1 $CFG(FN_PAD) -spacing3 $CFG(FN_PAD)
523
bindtags $c ". $c Text all"
524
bind $c <1> {focus %W}
525
}
526
527
label .nameA
528
label .nameB
529
label .nameC
530
label .nameD -text {Merge Result}
531
::ttk::scrollbar .sby -command {.txtA yview} -orient vertical
532
::ttk::scrollbar .sbxA -command {.txtA xview} -orient horizontal
533
::ttk::scrollbar .sbxB -command {.txtB xview} -orient horizontal
534
::ttk::scrollbar .sbxC -command {.txtC xview} -orient horizontal
535
::ttk::scrollbar .sbxD -command {.txtD xview} -orient horizontal
536
frame .spacer
537
538
update idletasks
539
540
proc searchOnOff {} {
541
if {[info exists ::search]} {
542
unset ::search
543
.txtA tag remove search 1.0 end
544
.txtB tag remove search 1.0 end
545
.txtC tag remove search 1.0 end
546
.txtD tag remove search 1.0 end
547
pack forget .bb.sframe
548
focus .
549
} else {
550
set ::search .txtA
551
if {![winfo exists .bb.sframe]} {
552
frame .bb.sframe
553
::ttk::entry .bb.sframe.e -width 10
554
pack .bb.sframe.e -side left -fill y -expand 1
555
bind .bb.sframe.e <Return> {searchNext; break}
556
::ttk::button .bb.sframe.nx -text \u2193 -width 1 -command searchNext
557
::ttk::button .bb.sframe.pv -text \u2191 -width 1 -command searchPrev
558
tk_optionMenu .bb.sframe.typ ::search_type \
559
Exact {No Case} {RegExp} {Whole Word}
560
.bb.sframe.typ config -width 10
561
set ::search_type Exact
562
pack .bb.sframe.nx .bb.sframe.pv .bb.sframe.typ -side left
563
}
564
pack .bb.sframe -side left
565
after idle {focus .bb.sframe.e}
566
}
567
}
568
proc searchNext {} {searchStep -forwards +1 1.0 end}
569
proc searchPrev {} {searchStep -backwards -1 end 1.0}
570
proc searchStep {direction incr start stop} {
571
set pattern [.bb.sframe.e get]
572
if {$pattern==""} return
573
set count 0
574
set w $::search
575
switch $w {
576
.txtA {set other .txtB}
577
.txtB {set other .txtC}
578
.txtC {set other .txtD}
579
default {set other .txtA}
580
}
581
if {[lsearch [$w mark names] search]<0} {
582
$w mark set search $start
583
}
584
switch $::search_type {
585
Exact {set st -exact}
586
{No Case} {set st -nocase}
587
{RegExp} {set st -regexp}
588
{Whole Word} {set st -regexp; set pattern \\y$pattern\\y}
589
}
590
set idx [$w search -count count $direction $st -- \
591
$pattern "search $incr chars" $stop]
592
if {"$idx"==""} {
593
set idx [$other search -count count $direction $st -- $pattern $start $stop]
594
if {"$idx"!=""} {
595
set this $w
596
set w $other
597
set other $this
598
} else {
599
set idx [$w search -count count $direction $st -- $pattern $start $stop]
600
}
601
}
602
$w tag remove search 1.0 end
603
$w mark unset search
604
$other tag remove search 1.0 end
605
$other mark unset search
606
if {"$idx"!=""} {
607
$w mark set search $idx
608
$w yview -pickplace $idx
609
$w tag add search search "$idx +$count chars"
610
$w tag config search -background {#fcc000}
611
}
612
set ::search $w
613
}
614
::ttk::button .bb.quit -text {Quit} -command exit
615
::ttk::button .bb.search -text {Search} -command searchOnOff
616
pack .bb.quit -side left -fill y
617
pack .bb.diff2 -side left -fill y
618
if {[winfo exists .bb.files]} {
619
pack .bb.files -side left -fill y
620
}
621
pack .bb.ctxtag .bb.ctx -side left -fill y
622
pack .bb.search -side left -fill y
623
grid rowconfigure . 1 -weight 1 -minsize [winfo reqheight .nameA]
624
grid rowconfigure . 2 -weight 100
625
readMerge
626
grid .bb -row 0 -columnspan 8
627
grid .nameA -row 1 -column 1 -sticky ew
628
grid .nameB -row 1 -column 3 -sticky ew
629
grid .nameC -row 1 -column 5 -sticky ew
630
grid .nameD -row 1 -column 7 -sticky ew
631
eval grid [cols] -row 2 -sticky nsew
632
grid .sby -row 2 -column 8 -sticky ns
633
grid .sbxA -row 3 -column 1 -sticky ew
634
grid .sbxB -row 3 -column 3 -sticky ew
635
grid .sbxC -row 3 -column 5 -sticky ew
636
grid .sbxD -row 3 -column 7 -sticky ew
637
grid columnconfigure . {0 2 4 6} \
638
-weight 1 -uniform a -minsize [winfo reqwidth .lnA]
639
grid columnconfigure . {1 3 5 7} -weight 100 -uniform b
640
641
.spacer config -height [winfo height .sbxA]
642
wm deiconify .
643

Keyboard Shortcuts

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