Fossil SCM

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

Keyboard Shortcuts

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