Fossil SCM

Improved controls at the top of the --tk merge information GUI.

drh 2024-12-04 18:49 trunk
Commit f8932be5aa8964d0cae016966f826aec38e46aa4d1ea1a19994701d526de34fb
Parent 4f9ecd0392368b7…
2 files changed +5 -8 +51 -19
~ src/merge.c ~ src/merge.tcl
M src/merge.c
+5 -8
--- src/merge.c
+++ src/merge.c
@@ -41,11 +41,12 @@
4141
 ** for testing and debugging. */
4242
 zTempFile = find_option("script",0,1);
4343
 verify_all_options();
4444
4545
 blob_zero(&script);
46
- blob_appendf(&script, "set fossilcmd {| \"%/\" merge-info -tcl }\n",
46
+ blob_appendf(&script, "set ncontext %d\n", nContext);
47
+ blob_appendf(&script, "set fossilcmd {| \"%/\" merge-info}\n",
4748
 g.nameOfExe);
4849
 blob_appendf(&script, "set filelist [list");
4950
 if( g.argc==2 ){
5051
 /* No files named on the command-line. Use every file mentioned
5152
 ** in the MERGESTAT table to generate the file list. */
@@ -238,18 +239,14 @@
238239
 **
239240
 ** Usage: %fossil merge-info [OPTIONS]
240241
 **
241242
 ** Display information about the most recent merge operation.
242243
 **
243
-** Right now, this command basically just dumps the localdb.mergestat
244
-** table. The plan moving forward is that it can generate data for
245
-** a Tk-based GUI to show the details of the merge. This command is
246
-** a work-in-progress.
247
-**
248244
 ** Options:
249
-** -a|--all Show all changes. Normally only merges, conflicts,
250
-** and errors are shown.
245
+** -a|--all Show all all file changes that happened because of
246
+** the merge. Normally only MERGE, CONFLICT, and ERROR
247
+** lines are shown
251248
 ** -c|--context N Show N lines of context around each change,
252249
 ** with negative N meaning show all content. Only
253250
 ** meaningful in combination with --tcl or --tk.
254251
 ** --dark Use dark mode for the Tcl/Tk-based GUI
255252
 ** --tcl FILE Generate (to stdout) a TCL list containing
256253
--- src/merge.c
+++ src/merge.c
@@ -41,11 +41,12 @@
41 ** for testing and debugging. */
42 zTempFile = find_option("script",0,1);
43 verify_all_options();
44
45 blob_zero(&script);
46 blob_appendf(&script, "set fossilcmd {| \"%/\" merge-info -tcl }\n",
 
47 g.nameOfExe);
48 blob_appendf(&script, "set filelist [list");
49 if( g.argc==2 ){
50 /* No files named on the command-line. Use every file mentioned
51 ** in the MERGESTAT table to generate the file list. */
@@ -238,18 +239,14 @@
238 **
239 ** Usage: %fossil merge-info [OPTIONS]
240 **
241 ** Display information about the most recent merge operation.
242 **
243 ** Right now, this command basically just dumps the localdb.mergestat
244 ** table. The plan moving forward is that it can generate data for
245 ** a Tk-based GUI to show the details of the merge. This command is
246 ** a work-in-progress.
247 **
248 ** Options:
249 ** -a|--all Show all changes. Normally only merges, conflicts,
250 ** and errors are shown.
 
251 ** -c|--context N Show N lines of context around each change,
252 ** with negative N meaning show all content. Only
253 ** meaningful in combination with --tcl or --tk.
254 ** --dark Use dark mode for the Tcl/Tk-based GUI
255 ** --tcl FILE Generate (to stdout) a TCL list containing
256
--- src/merge.c
+++ src/merge.c
@@ -41,11 +41,12 @@
41 ** for testing and debugging. */
42 zTempFile = find_option("script",0,1);
43 verify_all_options();
44
45 blob_zero(&script);
46 blob_appendf(&script, "set ncontext %d\n", nContext);
47 blob_appendf(&script, "set fossilcmd {| \"%/\" merge-info}\n",
48 g.nameOfExe);
49 blob_appendf(&script, "set filelist [list");
50 if( g.argc==2 ){
51 /* No files named on the command-line. Use every file mentioned
52 ** in the MERGESTAT table to generate the file list. */
@@ -238,18 +239,14 @@
239 **
240 ** Usage: %fossil merge-info [OPTIONS]
241 **
242 ** Display information about the most recent merge operation.
243 **
 
 
 
 
 
244 ** Options:
245 ** -a|--all Show all all file changes that happened because of
246 ** the merge. Normally only MERGE, CONFLICT, and ERROR
247 ** lines are shown
248 ** -c|--context N Show N lines of context around each change,
249 ** with negative N meaning show all content. Only
250 ** meaningful in combination with --tcl or --tk.
251 ** --dark Use dark mode for the Tcl/Tk-based GUI
252 ** --tcl FILE Generate (to stdout) a TCL list containing
253
M src/merge.tcl
+51 -19
--- src/merge.tcl
+++ src/merge.tcl
@@ -1,11 +1,22 @@
1
-# The "--tk" option to various merge commands prepends one or more
2
-# "set fossilcmd(NAME) {...}" lines to this file, then runs this file using
3
-# "tclsh" in order to show a graphical analysis of the merge results.
4
-# A typical "set fossilcmd" line looks like this:
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
+# There is always a "fossilcmd" variable which tells the script how to
6
+# invoke Fossil to get the information it needs. This script will
7
+# automatically append "-c N" to tell Fossil how much context it wants.
8
+#
9
+# If the "filelist" global variable is defined, then it is a list of
10
+# alternating "merge-type names" (ex: UPDATE, MERGE, CONFLICT, ERROR) and
11
+# filenames. In that case, the initial display shows the changes for
12
+# the first pair on the list and there is a optionmenu that allows the
13
+# user to select other fiels on the list.
514
 #
6
-# set fossilcmd(file1.txt) {| "./fossil" diff --tcl -i -v}
15
+# There should also be a global variable named "ncontext" which is the
16
+# number of lines of context to display. The value of this variable
17
+# controls the "-c N" argument that is appended to fossilcmd.
718
 #
819
 # This header comment is stripped off by the "mkbuiltin.c" program.
920
 #
1021
 package require Tk
1122
@@ -81,15 +92,29 @@
8192
 proc colType {c} {
8293
 regexp {[a-z]+} $c type
8394
 return $type
8495
 }
8596
86
-proc readMerge {fossilcmd} {
87
- set in [open $fossilcmd r]
88
- fconfigure $in -encoding utf-8
89
- set mergetxt [read $in]
90
- close $in
97
+proc readMerge {args} {
98
+ global fossilcmd ncontext current_file
99
+ if {$ncontext=="All"} {
100
+ set cmd "$fossilcmd -c -1"
101
+ } else {
102
+ set cmd "$fossilcmd -c $ncontext"
103
+ }
104
+ if {[info exists current_file]} {
105
+ append cmd " -tcl [list $current_file]"
106
+ }
107
+ if {[catch {
108
+ set in [open $cmd r]
109
+ fconfigure $in -encoding utf-8
110
+ set mergetxt [read $in]
111
+ close $in
112
+ } msg]} {
113
+ tk_messageBox -message "Unable to run command: \"$cmd\""
114
+ return
115
+ }
91116
 foreach c [cols] {
92117
 $c config -state normal
93118
 $c delete 1.0 end
94119
 }
95120
 set lnA 1
@@ -309,11 +334,14 @@
309334
 bind . <Shift-$key> continue
310335
 }
311336
312337
 frame .bb
313338
 if {[info exists filelist]} {
314
- ::ttk::menubutton .bb.files -text "Files"
339
+ label .bb.filetag -text "File:"
340
+ set current_file [lindex $filelist 1]
341
+ trace add variable current_file write readMerge
342
+ ::ttk::menubutton .bb.files -text $current_file
315343
 if {[tk windowingsystem] eq "win32"} {
316344
 ::ttk::style theme use winnative
317345
 .bb.files configure -padding {20 1 10 2}
318346
 }
319347
 toplevel .wfiles
@@ -323,13 +351,17 @@
323351
 wm overrideredirect .wfiles 1
324352
 set ht [expr {[llength $filelist]/2}]
325353
 if {$ht>$CFG(LB_HEIGHT)} {set ht $CFG(LB_HEIGHT)}
326354
 listbox .wfiles.lb -width 0 -height $ht -activestyle none \
327355
 -yscroll {.wfiles.sb set}
356
+ set mx 1
328357
 foreach {op fn} $filelist {
358
+ set n [string length $fn]
359
+ if {$n>$mx} {set mx $n}
329360
 .wfiles.lb insert end [format "%-9s %s" $op $fn]
330361
 }
362
+ .bb.files config -width $mx
331363
 ::ttk::scrollbar .wfiles.sb -command {.wfiles.lb yview}
332364
 grid .wfiles.lb .wfiles.sb -sticky ns
333365
 bind .bb.files <1> {
334366
 set x [winfo rootx %W]
335367
 set y [expr {[winfo rooty %W]+[winfo height %W]}]
@@ -340,21 +372,24 @@
340372
 bind .wfiles <FocusOut> {wm withdraw .wfiles}
341373
 bind .wfiles <Escape> {focus .}
342374
 foreach evt {1 Return} {
343375
 bind .wfiles.lb <$evt> {
344376
 set ii [%W curselection]
345
- readMerge "$::fossilcmd [list [lindex $::filelist [expr {$ii*2+1}]]]"
377
+ set ::current_file [lindex $::filelist [expr {$ii*2+1}]]
378
+ .bb.files config -text $::current_file
346379
 focus .
347380
 break
348381
 }
349382
 }
350383
 bind .wfiles.lb <Motion> {
351384
 %W selection clear 0 end
352385
 %W selection set @%x,%y
353386
 }
354387
 }
355
-
388
+label .bb.ctxtag -text "Context:"
389
+tk_optionMenu .bb.ctx ncontext 3 6 12 25 40 100 All
390
+trace add variable ncontext write readMerge
356391
357392
 foreach {side syncCol} {A .txtB B .txtA C .txtC D .txtD} {
358393
 set ln .ln$side
359394
 text $ln
360395
 $ln tag config - -justify right
@@ -396,15 +431,11 @@
396431
 ::ttk::scrollbar .sbxB -command {.txtB xview} -orient horizontal
397432
 ::ttk::scrollbar .sbxC -command {.txtC xview} -orient horizontal
398433
 ::ttk::scrollbar .sbxD -command {.txtD xview} -orient horizontal
399434
 frame .spacer
400435
401
-if {[info exists filelist]} {
402
- readMerge "$fossilcmd [list [lindex $filelist 1]]"
403
-} else {
404
- readMerge $fossilcmd
405
-}
436
+readMerge
406437
 update idletasks
407438
408439
 proc searchOnOff {} {
409440
 if {[info exists ::search]} {
410441
 unset ::search
@@ -481,12 +512,13 @@
481512
 }
482513
 ::ttk::button .bb.quit -text {Quit} -command exit
483514
 ::ttk::button .bb.search -text {Search} -command searchOnOff
484515
 pack .bb.quit -side left
485516
 if {[info exists filelist]} {
486
- pack .bb.files -side left
517
+ pack .bb.filetag .bb.files -side left
487518
 }
519
+pack .bb.ctxtag .bb.ctx -side left
488520
 pack .bb.search -side left
489521
 grid rowconfigure . 1 -weight 1
490522
 set rn 0
491523
 foreach {lnwid txtwid} [cols] {
492524
 grid columnconfigure . $rn -weight 1 -uniform a
493525
--- src/merge.tcl
+++ src/merge.tcl
@@ -1,11 +1,22 @@
1 # The "--tk" option to various merge commands prepends one or more
2 # "set fossilcmd(NAME) {...}" lines to this file, then runs this file using
3 # "tclsh" in order to show a graphical analysis of the merge results.
4 # A typical "set fossilcmd" line looks like this:
 
 
 
 
 
 
 
 
 
5 #
6 # set fossilcmd(file1.txt) {| "./fossil" diff --tcl -i -v}
 
 
7 #
8 # This header comment is stripped off by the "mkbuiltin.c" program.
9 #
10 package require Tk
11
@@ -81,15 +92,29 @@
81 proc colType {c} {
82 regexp {[a-z]+} $c type
83 return $type
84 }
85
86 proc readMerge {fossilcmd} {
87 set in [open $fossilcmd r]
88 fconfigure $in -encoding utf-8
89 set mergetxt [read $in]
90 close $in
 
 
 
 
 
 
 
 
 
 
 
 
 
 
91 foreach c [cols] {
92 $c config -state normal
93 $c delete 1.0 end
94 }
95 set lnA 1
@@ -309,11 +334,14 @@
309 bind . <Shift-$key> continue
310 }
311
312 frame .bb
313 if {[info exists filelist]} {
314 ::ttk::menubutton .bb.files -text "Files"
 
 
 
315 if {[tk windowingsystem] eq "win32"} {
316 ::ttk::style theme use winnative
317 .bb.files configure -padding {20 1 10 2}
318 }
319 toplevel .wfiles
@@ -323,13 +351,17 @@
323 wm overrideredirect .wfiles 1
324 set ht [expr {[llength $filelist]/2}]
325 if {$ht>$CFG(LB_HEIGHT)} {set ht $CFG(LB_HEIGHT)}
326 listbox .wfiles.lb -width 0 -height $ht -activestyle none \
327 -yscroll {.wfiles.sb set}
 
328 foreach {op fn} $filelist {
 
 
329 .wfiles.lb insert end [format "%-9s %s" $op $fn]
330 }
 
331 ::ttk::scrollbar .wfiles.sb -command {.wfiles.lb yview}
332 grid .wfiles.lb .wfiles.sb -sticky ns
333 bind .bb.files <1> {
334 set x [winfo rootx %W]
335 set y [expr {[winfo rooty %W]+[winfo height %W]}]
@@ -340,21 +372,24 @@
340 bind .wfiles <FocusOut> {wm withdraw .wfiles}
341 bind .wfiles <Escape> {focus .}
342 foreach evt {1 Return} {
343 bind .wfiles.lb <$evt> {
344 set ii [%W curselection]
345 readMerge "$::fossilcmd [list [lindex $::filelist [expr {$ii*2+1}]]]"
 
346 focus .
347 break
348 }
349 }
350 bind .wfiles.lb <Motion> {
351 %W selection clear 0 end
352 %W selection set @%x,%y
353 }
354 }
355
 
 
356
357 foreach {side syncCol} {A .txtB B .txtA C .txtC D .txtD} {
358 set ln .ln$side
359 text $ln
360 $ln tag config - -justify right
@@ -396,15 +431,11 @@
396 ::ttk::scrollbar .sbxB -command {.txtB xview} -orient horizontal
397 ::ttk::scrollbar .sbxC -command {.txtC xview} -orient horizontal
398 ::ttk::scrollbar .sbxD -command {.txtD xview} -orient horizontal
399 frame .spacer
400
401 if {[info exists filelist]} {
402 readMerge "$fossilcmd [list [lindex $filelist 1]]"
403 } else {
404 readMerge $fossilcmd
405 }
406 update idletasks
407
408 proc searchOnOff {} {
409 if {[info exists ::search]} {
410 unset ::search
@@ -481,12 +512,13 @@
481 }
482 ::ttk::button .bb.quit -text {Quit} -command exit
483 ::ttk::button .bb.search -text {Search} -command searchOnOff
484 pack .bb.quit -side left
485 if {[info exists filelist]} {
486 pack .bb.files -side left
487 }
 
488 pack .bb.search -side left
489 grid rowconfigure . 1 -weight 1
490 set rn 0
491 foreach {lnwid txtwid} [cols] {
492 grid columnconfigure . $rn -weight 1 -uniform a
493
--- src/merge.tcl
+++ src/merge.tcl
@@ -1,11 +1,22 @@
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 # There is always a "fossilcmd" variable which tells the script how to
6 # invoke Fossil to get the information it needs. This script will
7 # automatically append "-c N" to tell Fossil how much context it wants.
8 #
9 # If the "filelist" global variable is defined, then it is a list of
10 # alternating "merge-type names" (ex: UPDATE, MERGE, CONFLICT, ERROR) and
11 # filenames. In that case, the initial display shows the changes for
12 # the first pair on the list and there is a optionmenu that allows the
13 # user to select other fiels on the list.
14 #
15 # There should also be a global variable named "ncontext" which is the
16 # number of lines of context to display. The value of this variable
17 # controls the "-c N" argument that is appended to fossilcmd.
18 #
19 # This header comment is stripped off by the "mkbuiltin.c" program.
20 #
21 package require Tk
22
@@ -81,15 +92,29 @@
92 proc colType {c} {
93 regexp {[a-z]+} $c type
94 return $type
95 }
96
97 proc readMerge {args} {
98 global fossilcmd ncontext current_file
99 if {$ncontext=="All"} {
100 set cmd "$fossilcmd -c -1"
101 } else {
102 set cmd "$fossilcmd -c $ncontext"
103 }
104 if {[info exists current_file]} {
105 append cmd " -tcl [list $current_file]"
106 }
107 if {[catch {
108 set in [open $cmd r]
109 fconfigure $in -encoding utf-8
110 set mergetxt [read $in]
111 close $in
112 } msg]} {
113 tk_messageBox -message "Unable to run command: \"$cmd\""
114 return
115 }
116 foreach c [cols] {
117 $c config -state normal
118 $c delete 1.0 end
119 }
120 set lnA 1
@@ -309,11 +334,14 @@
334 bind . <Shift-$key> continue
335 }
336
337 frame .bb
338 if {[info exists filelist]} {
339 label .bb.filetag -text "File:"
340 set current_file [lindex $filelist 1]
341 trace add variable current_file write readMerge
342 ::ttk::menubutton .bb.files -text $current_file
343 if {[tk windowingsystem] eq "win32"} {
344 ::ttk::style theme use winnative
345 .bb.files configure -padding {20 1 10 2}
346 }
347 toplevel .wfiles
@@ -323,13 +351,17 @@
351 wm overrideredirect .wfiles 1
352 set ht [expr {[llength $filelist]/2}]
353 if {$ht>$CFG(LB_HEIGHT)} {set ht $CFG(LB_HEIGHT)}
354 listbox .wfiles.lb -width 0 -height $ht -activestyle none \
355 -yscroll {.wfiles.sb set}
356 set mx 1
357 foreach {op fn} $filelist {
358 set n [string length $fn]
359 if {$n>$mx} {set mx $n}
360 .wfiles.lb insert end [format "%-9s %s" $op $fn]
361 }
362 .bb.files config -width $mx
363 ::ttk::scrollbar .wfiles.sb -command {.wfiles.lb yview}
364 grid .wfiles.lb .wfiles.sb -sticky ns
365 bind .bb.files <1> {
366 set x [winfo rootx %W]
367 set y [expr {[winfo rooty %W]+[winfo height %W]}]
@@ -340,21 +372,24 @@
372 bind .wfiles <FocusOut> {wm withdraw .wfiles}
373 bind .wfiles <Escape> {focus .}
374 foreach evt {1 Return} {
375 bind .wfiles.lb <$evt> {
376 set ii [%W curselection]
377 set ::current_file [lindex $::filelist [expr {$ii*2+1}]]
378 .bb.files config -text $::current_file
379 focus .
380 break
381 }
382 }
383 bind .wfiles.lb <Motion> {
384 %W selection clear 0 end
385 %W selection set @%x,%y
386 }
387 }
388 label .bb.ctxtag -text "Context:"
389 tk_optionMenu .bb.ctx ncontext 3 6 12 25 40 100 All
390 trace add variable ncontext write readMerge
391
392 foreach {side syncCol} {A .txtB B .txtA C .txtC D .txtD} {
393 set ln .ln$side
394 text $ln
395 $ln tag config - -justify right
@@ -396,15 +431,11 @@
431 ::ttk::scrollbar .sbxB -command {.txtB xview} -orient horizontal
432 ::ttk::scrollbar .sbxC -command {.txtC xview} -orient horizontal
433 ::ttk::scrollbar .sbxD -command {.txtD xview} -orient horizontal
434 frame .spacer
435
436 readMerge
 
 
 
 
437 update idletasks
438
439 proc searchOnOff {} {
440 if {[info exists ::search]} {
441 unset ::search
@@ -481,12 +512,13 @@
512 }
513 ::ttk::button .bb.quit -text {Quit} -command exit
514 ::ttk::button .bb.search -text {Search} -command searchOnOff
515 pack .bb.quit -side left
516 if {[info exists filelist]} {
517 pack .bb.filetag .bb.files -side left
518 }
519 pack .bb.ctxtag .bb.ctx -side left
520 pack .bb.search -side left
521 grid rowconfigure . 1 -weight 1
522 set rn 0
523 foreach {lnwid txtwid} [cols] {
524 grid columnconfigure . $rn -weight 1 -uniform a
525

Keyboard Shortcuts

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