summaryrefslogtreecommitdiff
path: root/src/merge.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'src/merge.tcl')
-rw-r--r--src/merge.tcl642
1 files changed, 642 insertions, 0 deletions
diff --git a/src/merge.tcl b/src/merge.tcl
new file mode 100644
index 0000000..9088c31
--- /dev/null
+++ b/src/merge.tcl
@@ -0,0 +1,642 @@
+# Show details of a 3-way merge operation. The left-most column is the
+# common ancestor. The next two columns are edits of that common ancestor.
+# The right-most column is the result of the merge.
+#
+# Several variables will have been initialized:
+#
+# ncontext The number of lines of context to show on each change
+#
+# fossilexe Pathname of the fossil program
+#
+# filelist A list of "merge-type filename" pairs.
+#
+# darkmode Boolean. True for dark mode
+#
+# debug Boolean. True for debugging output
+#
+# If the "filelist" global variable is defined, then it is a list of
+# alternating "merge-type names" (ex: UPDATE, MERGE, CONFLICT, ERROR) and
+# filenames. In that case, the initial display shows the changes for
+# the first pair on the list and there is a optionmenu that allows the
+# user to select other fiels on the list.
+#
+# This header comment is stripped off by the "mkbuiltin.c" program.
+#
+package require Tk
+
+array set CFG_light {
+ TITLE {Fossil Merge}
+ LN_COL_BG #dddddd
+ LN_COL_FG #444444
+ TXT_COL_BG #ffffff
+ TXT_COL_FG #000000
+ MKR_COL_BG #444444
+ MKR_COL_FG #dddddd
+ CHNG_BG #d0d070
+ ADD_BG #c0ffc0
+ RM_BG #ffc0c0
+ HR_FG #444444
+ HR_PAD_TOP 4
+ HR_PAD_BTM 8
+ FN_BG #444444
+ FN_FG #ffffff
+ FN_PAD 5
+ ERR_FG #ee0000
+ PADX 5
+ WIDTH 80
+ HEIGHT 45
+ LB_HEIGHT 25
+}
+
+array set CFG_dark {
+ TITLE {Fossil Merge}
+ LN_COL_BG #dddddd
+ LN_COL_FG #444444
+ TXT_COL_BG #3f3f3f
+ TXT_COL_FG #dcdccc
+ MKR_COL_BG #444444
+ MKR_COL_FG #dddddd
+ CHNG_BG #6a6a00
+ ADD_BG #57934c
+ RM_BG #ef6767
+ HR_FG #444444
+ HR_PAD_TOP 4
+ HR_PAD_BTM 8
+ FN_BG #5e5e5e
+ FN_FG #ffffff
+ FN_PAD 5
+ ERR_FG #ee0000
+ PADX 5
+ WIDTH 80
+ HEIGHT 45
+ LB_HEIGHT 25
+}
+
+array set CFG_arr {
+ 0 CFG_light
+ 1 CFG_dark
+}
+
+array set CFG [array get $CFG_arr($darkmode)]
+
+if {![namespace exists ttk]} {
+ interp alias {} ::ttk::scrollbar {} ::scrollbar
+ interp alias {} ::ttk::menubutton {} ::menubutton
+}
+
+proc dehtml {x} {
+ set x [regsub -all {<[^>]*>} $x {}]
+ return [string map {&amp; & &lt; < &gt; > &#39; ' &quot; \"} $x]
+}
+
+proc cols {} {
+ return [list .lnA .txtA .lnB .txtB .lnC .txtC .lnD .txtD]
+}
+
+proc colType {c} {
+ regexp {[a-z]+} $c type
+ return $type
+}
+
+proc readMerge {args} {
+ global fossilexe ncontext current_file debug
+ if {$ncontext=="All"} {
+ set cmd "| $fossilexe merge-info -c -1"
+ } else {
+ set cmd "| $fossilexe merge-info -c $ncontext"
+ }
+ if {[info exists current_file]} {
+ regsub {^[A-Z]+ } $current_file {} fn
+ lappend cmd -tcl $fn
+ }
+ if {$debug} {
+ regsub {^\| +} $cmd {} cmd2
+ puts $cmd2
+ flush stdout
+ }
+ if {[catch {
+ set in [open $cmd r]
+ fconfigure $in -encoding utf-8
+ set mergetxt [read $in]
+ close $in
+ } msg]} {
+ tk_messageBox -message "Unable to run command: \"$cmd\""
+ set mergetxt {}
+ }
+ foreach c [cols] {
+ $c config -state normal
+ $c delete 1.0 end
+ }
+ set lnA 1
+ set lnB 1
+ set lnC 1
+ set lnD 1
+ foreach {A B C D} $mergetxt {
+ set key1 [string index $A 0]
+ if {$key1=="S"} {
+ scan [string range $A 1 end] "%d %d %d %d" nA nB nC nD
+ foreach x {A B C D} {
+ set N [set n$x]
+ incr ln$x $N
+ if {$N>0} {
+ .ln$x insert end ...\n hrln
+ .txt$x insert end [string repeat . 30]\n hrtxt
+ } else {
+ .ln$x insert end \n hrln
+ .txt$x insert end \n hrtxt
+ }
+ }
+ continue
+ }
+ set key2 [string index $B 0]
+ set key3 [string index $C 0]
+ set key4 [string index $D 0]
+ if {$key1=="."} {
+ .lnA insert end \n -
+ .txtA insert end \n -
+ } elseif {$key1=="N"} {
+ .nameA config -text [string range $A 1 end]
+ } else {
+ .lnA insert end $lnA\n -
+ incr lnA
+ if {$key1=="X"} {
+ .txtA insert end [string range $A 1 end]\n rm
+ } else {
+ .txtA insert end [string range $A 1 end]\n -
+ }
+ }
+ if {$key2=="."} {
+ .lnB insert end \n -
+ .txtB insert end \n -
+ } elseif {$key2=="N"} {
+ .nameB config -text [string range $B 1 end]
+ } else {
+ .lnB insert end $lnB\n -
+ incr lnB
+ if {$key4=="2"} {set tag chng} {set tag -}
+ if {$key2=="1"} {
+ .txtB insert end [string range $A 1 end]\n $tag
+ } elseif {$key2=="X"} {
+ .txtB insert end [string range $B 1 end]\n rm
+ } else {
+ .txtB insert end [string range $B 1 end]\n $tag
+ }
+ }
+ if {$key3=="."} {
+ .lnC insert end \n -
+ .txtC insert end \n -
+ } elseif {$key3=="N"} {
+ .nameC config -text [string range $C 1 end]
+ } else {
+ .lnC insert end $lnC\n -
+ incr lnC
+ if {$key4=="3"} {set tag add} {set tag -}
+ if {$key3=="1"} {
+ .txtC insert end [string range $A 1 end]\n $tag
+ } elseif {$key3=="2"} {
+ .txtC insert end [string range $B 1 end]\n chng
+ } elseif {$key3=="X"} {
+ .txtC insert end [string range $C 1 end]\n rm
+ } else {
+ .txtC insert end [string range $C 1 end]\n $tag
+ }
+ }
+ if {$key4=="."} {
+ .lnD insert end \n -
+ .txtD insert end \n -
+ } elseif {$key4=="N"} {
+ .nameD config -text [string range $D 1 end]
+ } else {
+ .lnD insert end $lnD\n -
+ incr lnD
+ if {$key4=="1"} {
+ .txtD insert end [string range $A 1 end]\n -
+ } elseif {$key4=="2"} {
+ .txtD insert end [string range $B 1 end]\n chng
+ } elseif {$key4=="3"} {
+ .txtD insert end [string range $C 1 end]\n add
+ } elseif {$key4=="X"} {
+ .txtD insert end [string range $D 1 end]\n rm
+ } else {
+ .txtD insert end [string range $D 1 end]\n -
+ }
+ }
+ }
+ foreach c [cols] {
+ set type [colType $c]
+ if {$type ne "txt"} {
+ $c config -width 6; # $widths($type)
+ }
+ $c config -state disabled
+ }
+ set mx $lnA
+ if {$lnB>$mx} {set mx $lnB}
+ if {$lnC>$mx} {set mx $lnC}
+ if {$lnD>$mx} {set mx $lnD}
+ global lnWidth
+ set lnWidth [string length [format +%d $mx]]
+ .lnA config -width $lnWidth
+ .lnB config -width $lnWidth
+ .lnC config -width $lnWidth
+ .lnD config -width $lnWidth
+ grid columnconfig . {0 2 4 6} -minsize $lnWidth
+}
+
+proc viewDiff {idx} {
+ .txtA yview $idx
+ .txtA xview moveto 0
+}
+
+proc cycleDiffs {{reverse 0}} {
+ if {$reverse} {
+ set range [.txtA tag prevrange fn @0,0 1.0]
+ if {$range eq ""} {
+ viewDiff {fn.last -1c}
+ } else {
+ viewDiff [lindex $range 0]
+ }
+ } else {
+ set range [.txtA tag nextrange fn {@0,0 +1c} end]
+ if {$range eq "" || [lindex [.txtA yview] 1] == 1} {
+ viewDiff fn.first
+ } else {
+ viewDiff [lindex $range 0]
+ }
+ }
+}
+
+proc xvis {col} {
+ set view [$col xview]
+ return [expr {[lindex $view 1]-[lindex $view 0]}]
+}
+
+proc scroll-x {args} {
+ set c .txt[expr {[xvis .txtA] < [xvis .txtB] ? "A" : "B"}]
+ eval $c xview $args
+}
+
+interp alias {} scroll-y {} .txtA yview
+
+proc noop {args} {}
+
+proc enableSync {axis} {
+ update idletasks
+ interp alias {} sync-$axis {}
+ rename _sync-$axis sync-$axis
+}
+
+proc disableSync {axis} {
+ rename sync-$axis _sync-$axis
+ interp alias {} sync-$axis {} noop
+}
+
+proc sync-y {first last} {
+ disableSync y
+ foreach c [cols] {
+ $c yview moveto $first
+ }
+ if {$first > 0 || $last < 1} {
+ grid .sby
+ .sby set $first $last
+ } else {
+ grid remove .sby
+ }
+ enableSync y
+}
+
+wm withdraw .
+wm title . $CFG(TITLE)
+wm iconname . $CFG(TITLE)
+# Keystroke bindings for on the top-level window for navigation and
+# control also fire when those same keystrokes are pressed in the
+# Search entry box. Disable them, to prevent the diff screen from
+# disappearing abruptly and unexpectedly when searching for "q".
+#
+bind . <Control-q> exit
+bind . <Control-p> {catch searchPrev; break}
+bind . <Control-n> {catch searchNext; break}
+bind . <Escape><Escape> exit
+bind . <Destroy> {after 0 exit}
+bind . <Tab> {cycleDiffs; break}
+bind . <<PrevWindow>> {cycleDiffs 1; break}
+bind . <Control-f> {searchOnOff; break}
+bind . <Control-g> {catch searchNext; break}
+bind . <Return> {
+ event generate .bb.files <1>
+ event generate .bb.files <ButtonRelease-1>
+ break
+}
+foreach {key axis args} {
+ Up y {scroll -5 units}
+ k y {scroll -5 units}
+ Down y {scroll 5 units}
+ j y {scroll 5 units}
+ Left x {scroll -5 units}
+ h x {scroll -5 units}
+ Right x {scroll 5 units}
+ l x {scroll 5 units}
+ Prior y {scroll -1 page}
+ b y {scroll -1 page}
+ Next y {scroll 1 page}
+ space y {scroll 1 page}
+ Home y {moveto 0}
+ g y {moveto 0}
+ End y {moveto 1}
+} {
+ bind . <$key> "scroll-$axis $args; break"
+ bind . <Shift-$key> continue
+}
+
+frame .bb
+::ttk::menubutton .bb.diff2 -text {2-way diff} -menu .bb.diff2.m
+menu .bb.diff2.m -tearoff 0
+.bb.diff2.m add command -label {baseline vs. local} -command {two-way 12}
+.bb.diff2.m add command -label {baseline vs. merge-in} -command {two-way 13}
+.bb.diff2.m add command -label {local vs. merge-in} -command {two-way 23}
+
+# Bring up a separate two-way diff between a pair of columns
+# the argument is one of:
+# 12 Baseline versus Local
+# 13 Baseline versus Merge-in
+# 23 Local versus Merge-in
+#
+proc two-way {mode} {
+ global current_file fossilexe debug darkmode ncontext
+ regsub {^[A-Z]+ } $current_file {} fn
+ set cmd $fossilexe
+ lappend cmd merge-info --diff$mode $fn -c $ncontext
+ if {$darkmode} {
+ lappend cmd --dark
+ }
+ if {$debug} {
+ lappend cmd --tkdebug
+ puts $cmd
+ flush stdout
+ }
+ exec {*}$cmd &
+}
+
+set useOptionMenu 1
+if {[info exists filelist]} {
+ set current_file "[lindex $filelist 0] [lindex $filelist 1]"
+ if {[llength $filelist]>2} {
+ trace add variable current_file write readMerge
+
+ if {$tcl_platform(os)=="Darwin" || [llength $filelist]<30} {
+ set fnlist {}
+ foreach {op fn} $filelist {lappend fnlist "$op $fn"}
+ tk_optionMenu .bb.files current_file {*}$fnlist
+ } else {
+ set useOptionMenu 0
+ ::ttk::menubutton .bb.files -text $current_file
+ if {[tk windowingsystem] eq "win32"} {
+ ::ttk::style theme use winnative
+ .bb.files configure -padding {20 1 10 2}
+ }
+ toplevel .wfiles
+ wm withdraw .wfiles
+ update idletasks
+ wm transient .wfiles .
+ wm overrideredirect .wfiles 1
+ set ht [expr {[llength $filelist]/2}]
+ if {$ht>$CFG(LB_HEIGHT)} {set ht $CFG(LB_HEIGHT)}
+ listbox .wfiles.lb -width 0 -height $ht -activestyle none \
+ -yscroll {.wfiles.sb set}
+ set mx 1
+ foreach {op fn} $filelist {
+ set n [string length $fn]
+ if {$n>$mx} {set mx $n}
+ .wfiles.lb insert end "$op $fn"
+ }
+ .bb.files config -width $mx
+ ::ttk::scrollbar .wfiles.sb -command {.wfiles.lb yview}
+ grid .wfiles.lb .wfiles.sb -sticky ns
+ bind .bb.files <1> {
+ set x [winfo rootx %W]
+ set y [expr {[winfo rooty %W]+[winfo height %W]}]
+ wm geometry .wfiles +$x+$y
+ wm deiconify .wfiles
+ focus .wfiles.lb
+ }
+ bind .wfiles <FocusOut> {wm withdraw .wfiles}
+ bind .wfiles <Escape> {focus .}
+ foreach evt {1 Return} {
+ bind .wfiles.lb <$evt> {
+ set ii [%W curselection]
+ set ::current_file [%W get $ii]
+ .bb.files config -text $::current_file
+ focus .
+ break
+ }
+ }
+ bind .wfiles.lb <Motion> {
+ %W selection clear 0 end
+ %W selection set @%x,%y
+ }
+ }
+ }
+}
+
+label .bb.ctxtag -text "Context:"
+set context_choices {3 6 12 25 50 100 All}
+if {$ncontext<0} {set ncontext All}
+trace add variable ncontext write readMerge
+if {$tcl_platform(os)=="Darwin" || $useOptionMenu} {
+ tk_optionMenu .bb.ctx ncontext {*}$context_choices
+} else {
+ ::ttk::menubutton .bb.ctx -text $ncontext
+ if {[tk windowingsystem] eq "win32"} {
+ ::ttk::style theme use winnative
+ .bb.ctx configure -padding {20 1 10 2}
+ }
+ toplevel .wctx
+ wm withdraw .wctx
+ update idletasks
+ wm transient .wctx .
+ wm overrideredirect .wctx 1
+ listbox .wctx.lb -width 0 -height 7 -activestyle none
+ .wctx.lb insert end {*}$context_choices
+ pack .wctx.lb
+ bind .bb.ctx <1> {
+ set x [winfo rootx %W]
+ set y [expr {[winfo rooty %W]+[winfo height %W]}]
+ wm geometry .wctx +$x+$y
+ wm deiconify .wctx
+ focus .wctx.lb
+ }
+ bind .wctx <FocusOut> {wm withdraw .wctx}
+ bind .wctx <Escape> {focus .}
+ foreach evt {1 Return} {
+ bind .wctx.lb <$evt> {
+ set ::ncontext [lindex $::context_choices [%W curselection]]
+ .bb.ctx config -text $::ncontext
+ focus .
+ break
+ }
+ }
+ bind .wctx.lb <Motion> {
+ %W selection clear 0 end
+ %W selection set @%x,%y
+ }
+}
+
+foreach {side syncCol} {A .txtA B .txtB C .txtC D .txtD} {
+ set ln .ln$side
+ text $ln -width 6
+ $ln tag config - -justify right
+
+ set txt .txt$side
+ text $txt -width $CFG(WIDTH) -height $CFG(HEIGHT) -wrap none \
+ -xscroll ".sbx$side set"
+ catch {$txt config -tabstyle wordprocessor} ;# Required for Tk>=8.5
+ foreach tag {add rm chng} {
+ $txt tag config $tag -background $CFG([string toupper $tag]_BG)
+ $txt tag lower $tag
+ }
+ $txt tag config fn -background $CFG(FN_BG) -foreground $CFG(FN_FG) \
+ -justify center
+ $txt tag config err -foreground $CFG(ERR_FG)
+}
+text .mkr
+
+set mxwidth [lindex [wm maxsize .] 0]
+while {$CFG(WIDTH)>=40} {
+ set wanted [expr {([winfo reqwidth .lnA]+[winfo reqwidth .txtA])*4+30}]
+ if {$wanted<=$mxwidth} break
+ incr CFG(WIDTH) -10
+ .txtA config -width $CFG(WIDTH)
+ .txtB config -width $CFG(WIDTH)
+ .txtC config -width $CFG(WIDTH)
+ .txtD config -width $CFG(WIDTH)
+}
+
+foreach c [cols] {
+ set keyPrefix [string toupper [colType $c]]_COL_
+ if {[tk windowingsystem] eq "win32"} {$c config -font {courier 9}}
+ $c config -bg $CFG(${keyPrefix}BG) -fg $CFG(${keyPrefix}FG) -borderwidth 0 \
+ -padx $CFG(PADX) -yscroll sync-y
+ $c tag config hrln -spacing1 $CFG(HR_PAD_TOP) -spacing3 $CFG(HR_PAD_BTM) \
+ -foreground $CFG(HR_FG) -justify right
+ $c tag config hrtxt -spacing1 $CFG(HR_PAD_TOP) -spacing3 $CFG(HR_PAD_BTM) \
+ -foreground $CFG(HR_FG) -justify center
+ $c tag config fn -spacing1 $CFG(FN_PAD) -spacing3 $CFG(FN_PAD)
+ bindtags $c ". $c Text all"
+ bind $c <1> {focus %W}
+}
+
+label .nameA
+label .nameB
+label .nameC
+label .nameD -text {Merge Result}
+::ttk::scrollbar .sby -command {.txtA yview} -orient vertical
+::ttk::scrollbar .sbxA -command {.txtA xview} -orient horizontal
+::ttk::scrollbar .sbxB -command {.txtB xview} -orient horizontal
+::ttk::scrollbar .sbxC -command {.txtC xview} -orient horizontal
+::ttk::scrollbar .sbxD -command {.txtD xview} -orient horizontal
+frame .spacer
+
+update idletasks
+
+proc searchOnOff {} {
+ if {[info exists ::search]} {
+ unset ::search
+ .txtA tag remove search 1.0 end
+ .txtB tag remove search 1.0 end
+ .txtC tag remove search 1.0 end
+ .txtD tag remove search 1.0 end
+ pack forget .bb.sframe
+ focus .
+ } else {
+ set ::search .txtA
+ if {![winfo exists .bb.sframe]} {
+ frame .bb.sframe
+ ::ttk::entry .bb.sframe.e -width 10
+ pack .bb.sframe.e -side left -fill y -expand 1
+ bind .bb.sframe.e <Return> {searchNext; break}
+ ::ttk::button .bb.sframe.nx -text \u2193 -width 1 -command searchNext
+ ::ttk::button .bb.sframe.pv -text \u2191 -width 1 -command searchPrev
+ tk_optionMenu .bb.sframe.typ ::search_type \
+ Exact {No Case} {RegExp} {Whole Word}
+ .bb.sframe.typ config -width 10
+ set ::search_type Exact
+ pack .bb.sframe.nx .bb.sframe.pv .bb.sframe.typ -side left
+ }
+ pack .bb.sframe -side left
+ after idle {focus .bb.sframe.e}
+ }
+}
+proc searchNext {} {searchStep -forwards +1 1.0 end}
+proc searchPrev {} {searchStep -backwards -1 end 1.0}
+proc searchStep {direction incr start stop} {
+ set pattern [.bb.sframe.e get]
+ if {$pattern==""} return
+ set count 0
+ set w $::search
+ switch $w {
+ .txtA {set other .txtB}
+ .txtB {set other .txtC}
+ .txtC {set other .txtD}
+ default {set other .txtA}
+ }
+ if {[lsearch [$w mark names] search]<0} {
+ $w mark set search $start
+ }
+ switch $::search_type {
+ Exact {set st -exact}
+ {No Case} {set st -nocase}
+ {RegExp} {set st -regexp}
+ {Whole Word} {set st -regexp; set pattern \\y$pattern\\y}
+ }
+ set idx [$w search -count count $direction $st -- \
+ $pattern "search $incr chars" $stop]
+ if {"$idx"==""} {
+ set idx [$other search -count count $direction $st -- $pattern $start $stop]
+ if {"$idx"!=""} {
+ set this $w
+ set w $other
+ set other $this
+ } else {
+ set idx [$w search -count count $direction $st -- $pattern $start $stop]
+ }
+ }
+ $w tag remove search 1.0 end
+ $w mark unset search
+ $other tag remove search 1.0 end
+ $other mark unset search
+ if {"$idx"!=""} {
+ $w mark set search $idx
+ $w yview -pickplace $idx
+ $w tag add search search "$idx +$count chars"
+ $w tag config search -background {#fcc000}
+ }
+ set ::search $w
+}
+::ttk::button .bb.quit -text {Quit} -command exit
+::ttk::button .bb.search -text {Search} -command searchOnOff
+pack .bb.quit -side left -fill y
+pack .bb.diff2 -side left -fill y
+if {[winfo exists .bb.files]} {
+ pack .bb.files -side left -fill y
+}
+pack .bb.ctxtag .bb.ctx -side left -fill y
+pack .bb.search -side left -fill y
+grid rowconfigure . 1 -weight 1 -minsize [winfo reqheight .nameA]
+grid rowconfigure . 2 -weight 100
+readMerge
+grid .bb -row 0 -columnspan 8
+grid .nameA -row 1 -column 1 -sticky ew
+grid .nameB -row 1 -column 3 -sticky ew
+grid .nameC -row 1 -column 5 -sticky ew
+grid .nameD -row 1 -column 7 -sticky ew
+eval grid [cols] -row 2 -sticky nsew
+grid .sby -row 2 -column 8 -sticky ns
+grid .sbxA -row 3 -column 1 -sticky ew
+grid .sbxB -row 3 -column 3 -sticky ew
+grid .sbxC -row 3 -column 5 -sticky ew
+grid .sbxD -row 3 -column 7 -sticky ew
+grid columnconfigure . {0 2 4 6} \
+ -weight 1 -uniform a -minsize [winfo reqwidth .lnA]
+grid columnconfigure . {1 3 5 7} -weight 100 -uniform b
+
+.spacer config -height [winfo height .sbxA]
+wm deiconify .
generated by cgit v1.3.1 (git 2.54.0) at 2026-10-17 07:45:12 +0000