|
|
|
@ -60,7 +60,7 @@ proc getcommitlines {commfd} {
@@ -60,7 +60,7 @@ proc getcommitlines {commfd} {
|
|
|
|
|
set stuff [read $commfd] |
|
|
|
|
if {$stuff == {}} { |
|
|
|
|
if {![eof $commfd]} return |
|
|
|
|
# this works around what is apparently a bug in Tcl... |
|
|
|
|
# set it blocking so we wait for the process to terminate |
|
|
|
|
fconfigure $commfd -blocking 1 |
|
|
|
|
if {![catch {close $commfd} err]} { |
|
|
|
|
after idle finishcommits |
|
|
|
@ -270,10 +270,10 @@ proc error_popup msg {
@@ -270,10 +270,10 @@ proc error_popup msg {
|
|
|
|
|
|
|
|
|
|
proc makewindow {} { |
|
|
|
|
global canv canv2 canv3 linespc charspc ctext cflist textfont |
|
|
|
|
global findtype findloc findstring fstring geometry |
|
|
|
|
global findtype findtypemenu findloc findstring fstring geometry |
|
|
|
|
global entries sha1entry sha1string sha1but |
|
|
|
|
global maincursor textcursor |
|
|
|
|
global rowctxmenu |
|
|
|
|
global rowctxmenu gaudydiff |
|
|
|
|
|
|
|
|
|
menu .bar |
|
|
|
|
.bar add cascade -label "File" -menu .bar.file |
|
|
|
@ -342,12 +342,15 @@ proc makewindow {} {
@@ -342,12 +342,15 @@ proc makewindow {} {
|
|
|
|
|
entry $fstring -width 30 -font $textfont -textvariable findstring |
|
|
|
|
pack $fstring -side left -expand 1 -fill x |
|
|
|
|
set findtype Exact |
|
|
|
|
tk_optionMenu .ctop.top.bar.findtype findtype Exact IgnCase Regexp |
|
|
|
|
set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \ |
|
|
|
|
findtype Exact IgnCase Regexp] |
|
|
|
|
set findloc "All fields" |
|
|
|
|
tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \ |
|
|
|
|
Comments Author Committer |
|
|
|
|
Comments Author Committer Files Pickaxe |
|
|
|
|
pack .ctop.top.bar.findloc -side right |
|
|
|
|
pack .ctop.top.bar.findtype -side right |
|
|
|
|
# for making sure type==Exact whenever loc==Pickaxe |
|
|
|
|
trace add variable findloc write findlocchange |
|
|
|
|
|
|
|
|
|
panedwindow .ctop.cdet -orient horizontal |
|
|
|
|
.ctop add .ctop.cdet |
|
|
|
@ -361,11 +364,17 @@ proc makewindow {} {
@@ -361,11 +364,17 @@ proc makewindow {} {
|
|
|
|
|
pack $ctext -side left -fill both -expand 1 |
|
|
|
|
.ctop.cdet add .ctop.cdet.left |
|
|
|
|
|
|
|
|
|
$ctext tag conf filesep -font [concat $textfont bold] |
|
|
|
|
$ctext tag conf hunksep -back blue -fore white |
|
|
|
|
$ctext tag conf d0 -back "#ff8080" |
|
|
|
|
$ctext tag conf d1 -back green |
|
|
|
|
$ctext tag conf found -back yellow |
|
|
|
|
$ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa" |
|
|
|
|
if {$gaudydiff} { |
|
|
|
|
$ctext tag conf hunksep -back blue -fore white |
|
|
|
|
$ctext tag conf d0 -back "#ff8080" |
|
|
|
|
$ctext tag conf d1 -back green |
|
|
|
|
} else { |
|
|
|
|
$ctext tag conf hunksep -fore blue |
|
|
|
|
$ctext tag conf d0 -fore red |
|
|
|
|
$ctext tag conf d1 -fore "#00a000" |
|
|
|
|
$ctext tag conf found -back yellow |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
frame .ctop.cdet.right |
|
|
|
|
set cflist .ctop.cdet.right.cfiles |
|
|
|
@ -397,12 +406,13 @@ proc makewindow {} {
@@ -397,12 +406,13 @@ proc makewindow {} {
|
|
|
|
|
bindkey b "$ctext yview scroll -1 pages" |
|
|
|
|
bindkey d "$ctext yview scroll 18 units" |
|
|
|
|
bindkey u "$ctext yview scroll -18 units" |
|
|
|
|
bindkey / findnext |
|
|
|
|
bindkey / {findnext 1} |
|
|
|
|
bindkey <Key-Return> {findnext 0} |
|
|
|
|
bindkey ? findprev |
|
|
|
|
bindkey f nextfile |
|
|
|
|
bind . <Control-q> doquit |
|
|
|
|
bind . <Control-f> dofind |
|
|
|
|
bind . <Control-g> findnext |
|
|
|
|
bind . <Control-g> {findnext 0} |
|
|
|
|
bind . <Control-r> findprev |
|
|
|
|
bind . <Control-equal> {incrfont 1} |
|
|
|
|
bind . <Control-KP_Add> {incrfont 1} |
|
|
|
@ -461,8 +471,10 @@ proc savestuff {w} {
@@ -461,8 +471,10 @@ proc savestuff {w} {
|
|
|
|
|
if {![winfo viewable .]} return |
|
|
|
|
catch { |
|
|
|
|
set f [open "~/.gitk-new" w] |
|
|
|
|
puts $f "set mainfont {$mainfont}" |
|
|
|
|
puts $f "set textfont {$textfont}" |
|
|
|
|
puts $f [list set mainfont $mainfont] |
|
|
|
|
puts $f [list set textfont $textfont] |
|
|
|
|
puts $f [list set findmergefiles $findmergefiles] |
|
|
|
|
puts $f [list set gaudydiff $gaudydiff] |
|
|
|
|
puts $f "set geometry(width) [winfo width .ctop]" |
|
|
|
|
puts $f "set geometry(height) [winfo height .ctop]" |
|
|
|
|
puts $f "set geometry(canv1) [expr [winfo width $canv]-2]" |
|
|
|
@ -1136,10 +1148,15 @@ proc dofind {} {
@@ -1136,10 +1148,15 @@ proc dofind {} {
|
|
|
|
|
global numcommits lineid linehtag linentag linedtag |
|
|
|
|
global mainfont namefont canv canv2 canv3 selectedline |
|
|
|
|
global matchinglines foundstring foundstrlen |
|
|
|
|
|
|
|
|
|
stopfindproc |
|
|
|
|
unmarkmatches |
|
|
|
|
focus . |
|
|
|
|
set matchinglines {} |
|
|
|
|
set fldtypes {Headline Author Date Committer CDate Comment} |
|
|
|
|
if {$findloc == "Pickaxe"} { |
|
|
|
|
findpatches |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
if {$findtype == "IgnCase"} { |
|
|
|
|
set foundstring [string tolower $findstring] |
|
|
|
|
} else { |
|
|
|
@ -1147,12 +1164,17 @@ proc dofind {} {
@@ -1147,12 +1164,17 @@ proc dofind {} {
|
|
|
|
|
} |
|
|
|
|
set foundstrlen [string length $findstring] |
|
|
|
|
if {$foundstrlen == 0} return |
|
|
|
|
if {$findloc == "Files"} { |
|
|
|
|
findfiles |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
if {![info exists selectedline]} { |
|
|
|
|
set oldsel -1 |
|
|
|
|
} else { |
|
|
|
|
set oldsel $selectedline |
|
|
|
|
} |
|
|
|
|
set didsel 0 |
|
|
|
|
set fldtypes {Headline Author Date Committer CDate Comment} |
|
|
|
|
for {set l 0} {$l < $numcommits} {incr l} { |
|
|
|
|
set id $lineid($l) |
|
|
|
|
set info $commitinfo($id) |
|
|
|
@ -1202,10 +1224,12 @@ proc findselectline {l} {
@@ -1202,10 +1224,12 @@ proc findselectline {l} {
|
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc findnext {} { |
|
|
|
|
proc findnext {restart} { |
|
|
|
|
global matchinglines selectedline |
|
|
|
|
if {![info exists matchinglines]} { |
|
|
|
|
dofind |
|
|
|
|
if {$restart} { |
|
|
|
|
dofind |
|
|
|
|
} |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
if {![info exists selectedline]} return |
|
|
|
@ -1237,6 +1261,308 @@ proc findprev {} {
@@ -1237,6 +1261,308 @@ proc findprev {} {
|
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc findlocchange {name ix op} { |
|
|
|
|
global findloc findtype findtypemenu |
|
|
|
|
if {$findloc == "Pickaxe"} { |
|
|
|
|
set findtype Exact |
|
|
|
|
set state disabled |
|
|
|
|
} else { |
|
|
|
|
set state normal |
|
|
|
|
} |
|
|
|
|
$findtypemenu entryconf 1 -state $state |
|
|
|
|
$findtypemenu entryconf 2 -state $state |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc stopfindproc {{done 0}} { |
|
|
|
|
global findprocpid findprocfile findids |
|
|
|
|
global ctext findoldcursor phase maincursor textcursor |
|
|
|
|
global findinprogress |
|
|
|
|
|
|
|
|
|
catch {unset findids} |
|
|
|
|
if {[info exists findprocpid]} { |
|
|
|
|
if {!$done} { |
|
|
|
|
catch {exec kill $findprocpid} |
|
|
|
|
} |
|
|
|
|
catch {close $findprocfile} |
|
|
|
|
unset findprocpid |
|
|
|
|
} |
|
|
|
|
if {[info exists findinprogress]} { |
|
|
|
|
unset findinprogress |
|
|
|
|
if {$phase != "incrdraw"} { |
|
|
|
|
. config -cursor $maincursor |
|
|
|
|
$ctext config -cursor $textcursor |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc findpatches {} { |
|
|
|
|
global findstring selectedline numcommits |
|
|
|
|
global findprocpid findprocfile |
|
|
|
|
global finddidsel ctext lineid findinprogress |
|
|
|
|
global findinsertpos |
|
|
|
|
|
|
|
|
|
if {$numcommits == 0} return |
|
|
|
|
|
|
|
|
|
# make a list of all the ids to search, starting at the one |
|
|
|
|
# after the selected line (if any) |
|
|
|
|
if {[info exists selectedline]} { |
|
|
|
|
set l $selectedline |
|
|
|
|
} else { |
|
|
|
|
set l -1 |
|
|
|
|
} |
|
|
|
|
set inputids {} |
|
|
|
|
for {set i 0} {$i < $numcommits} {incr i} { |
|
|
|
|
if {[incr l] >= $numcommits} { |
|
|
|
|
set l 0 |
|
|
|
|
} |
|
|
|
|
append inputids $lineid($l) "\n" |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
if {[catch { |
|
|
|
|
set f [open [list | git-diff-tree --stdin -s -r -S$findstring \ |
|
|
|
|
<< $inputids] r] |
|
|
|
|
} err]} { |
|
|
|
|
error_popup "Error starting search process: $err" |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
set findinsertpos end |
|
|
|
|
set findprocfile $f |
|
|
|
|
set findprocpid [pid $f] |
|
|
|
|
fconfigure $f -blocking 0 |
|
|
|
|
fileevent $f readable readfindproc |
|
|
|
|
set finddidsel 0 |
|
|
|
|
. config -cursor watch |
|
|
|
|
$ctext config -cursor watch |
|
|
|
|
set findinprogress 1 |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc readfindproc {} { |
|
|
|
|
global findprocfile finddidsel |
|
|
|
|
global idline matchinglines findinsertpos |
|
|
|
|
|
|
|
|
|
set n [gets $findprocfile line] |
|
|
|
|
if {$n < 0} { |
|
|
|
|
if {[eof $findprocfile]} { |
|
|
|
|
stopfindproc 1 |
|
|
|
|
if {!$finddidsel} { |
|
|
|
|
bell |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
if {![regexp {^[0-9a-f]{40}} $line id]} { |
|
|
|
|
error_popup "Can't parse git-diff-tree output: $line" |
|
|
|
|
stopfindproc |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
if {![info exists idline($id)]} { |
|
|
|
|
puts stderr "spurious id: $id" |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
set l $idline($id) |
|
|
|
|
insertmatch $l $id |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc insertmatch {l id} { |
|
|
|
|
global matchinglines findinsertpos finddidsel |
|
|
|
|
|
|
|
|
|
if {$findinsertpos == "end"} { |
|
|
|
|
if {$matchinglines != {} && $l < [lindex $matchinglines 0]} { |
|
|
|
|
set matchinglines [linsert $matchinglines 0 $l] |
|
|
|
|
set findinsertpos 1 |
|
|
|
|
} else { |
|
|
|
|
lappend matchinglines $l |
|
|
|
|
} |
|
|
|
|
} else { |
|
|
|
|
set matchinglines [linsert $matchinglines $findinsertpos $l] |
|
|
|
|
incr findinsertpos |
|
|
|
|
} |
|
|
|
|
markheadline $l $id |
|
|
|
|
if {!$finddidsel} { |
|
|
|
|
findselectline $l |
|
|
|
|
set finddidsel 1 |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc findfiles {} { |
|
|
|
|
global selectedline numcommits lineid ctext |
|
|
|
|
global ffileline finddidsel parents nparents |
|
|
|
|
global findinprogress findstartline findinsertpos |
|
|
|
|
global treediffs fdiffids fdiffsneeded fdiffpos |
|
|
|
|
global findmergefiles |
|
|
|
|
|
|
|
|
|
if {$numcommits == 0} return |
|
|
|
|
|
|
|
|
|
if {[info exists selectedline]} { |
|
|
|
|
set l [expr {$selectedline + 1}] |
|
|
|
|
} else { |
|
|
|
|
set l 0 |
|
|
|
|
} |
|
|
|
|
set ffileline $l |
|
|
|
|
set findstartline $l |
|
|
|
|
set diffsneeded {} |
|
|
|
|
set fdiffsneeded {} |
|
|
|
|
while 1 { |
|
|
|
|
set id $lineid($l) |
|
|
|
|
if {$findmergefiles || $nparents($id) == 1} { |
|
|
|
|
foreach p $parents($id) { |
|
|
|
|
if {![info exists treediffs([list $id $p])]} { |
|
|
|
|
append diffsneeded "$id $p\n" |
|
|
|
|
lappend fdiffsneeded [list $id $p] |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
if {[incr l] >= $numcommits} { |
|
|
|
|
set l 0 |
|
|
|
|
} |
|
|
|
|
if {$l == $findstartline} break |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
# start off a git-diff-tree process if needed |
|
|
|
|
if {$diffsneeded ne {}} { |
|
|
|
|
if {[catch { |
|
|
|
|
set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r] |
|
|
|
|
} err ]} { |
|
|
|
|
error_popup "Error starting search process: $err" |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
catch {unset fdiffids} |
|
|
|
|
set fdiffpos 0 |
|
|
|
|
fconfigure $df -blocking 0 |
|
|
|
|
fileevent $df readable [list readfilediffs $df] |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
set finddidsel 0 |
|
|
|
|
set findinsertpos end |
|
|
|
|
set id $lineid($l) |
|
|
|
|
set p [lindex $parents($id) 0] |
|
|
|
|
. config -cursor watch |
|
|
|
|
$ctext config -cursor watch |
|
|
|
|
set findinprogress 1 |
|
|
|
|
findcont [list $id $p] |
|
|
|
|
update |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc readfilediffs {df} { |
|
|
|
|
global findids fdiffids fdiffs |
|
|
|
|
|
|
|
|
|
set n [gets $df line] |
|
|
|
|
if {$n < 0} { |
|
|
|
|
if {[eof $df]} { |
|
|
|
|
donefilediff |
|
|
|
|
if {[catch {close $df} err]} { |
|
|
|
|
stopfindproc |
|
|
|
|
bell |
|
|
|
|
error_popup "Error in git-diff-tree: $err" |
|
|
|
|
} elseif {[info exists findids]} { |
|
|
|
|
set ids $findids |
|
|
|
|
stopfindproc |
|
|
|
|
bell |
|
|
|
|
error_popup "Couldn't find diffs for {$ids}" |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} { |
|
|
|
|
# start of a new string of diffs |
|
|
|
|
donefilediff |
|
|
|
|
set fdiffids [list $id $p] |
|
|
|
|
set fdiffs {} |
|
|
|
|
} elseif {[string match ":*" $line]} { |
|
|
|
|
lappend fdiffs [lindex $line 5] |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc donefilediff {} { |
|
|
|
|
global fdiffids fdiffs treediffs findids |
|
|
|
|
global fdiffsneeded fdiffpos |
|
|
|
|
|
|
|
|
|
if {[info exists fdiffids]} { |
|
|
|
|
while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids |
|
|
|
|
&& $fdiffpos < [llength $fdiffsneeded]} { |
|
|
|
|
# git-diff-tree doesn't output anything for a commit |
|
|
|
|
# which doesn't change anything |
|
|
|
|
set nullids [lindex $fdiffsneeded $fdiffpos] |
|
|
|
|
set treediffs($nullids) {} |
|
|
|
|
if {[info exists findids] && $nullids eq $findids} { |
|
|
|
|
unset findids |
|
|
|
|
findcont $nullids |
|
|
|
|
} |
|
|
|
|
incr fdiffpos |
|
|
|
|
} |
|
|
|
|
incr fdiffpos |
|
|
|
|
|
|
|
|
|
if {![info exists treediffs($fdiffids)]} { |
|
|
|
|
set treediffs($fdiffids) $fdiffs |
|
|
|
|
} |
|
|
|
|
if {[info exists findids] && $fdiffids eq $findids} { |
|
|
|
|
unset findids |
|
|
|
|
findcont $fdiffids |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc findcont {ids} { |
|
|
|
|
global findids treediffs parents nparents treepending |
|
|
|
|
global ffileline findstartline finddidsel |
|
|
|
|
global lineid numcommits matchinglines findinprogress |
|
|
|
|
global findmergefiles |
|
|
|
|
|
|
|
|
|
set id [lindex $ids 0] |
|
|
|
|
set p [lindex $ids 1] |
|
|
|
|
set pi [lsearch -exact $parents($id) $p] |
|
|
|
|
set l $ffileline |
|
|
|
|
while 1 { |
|
|
|
|
if {$findmergefiles || $nparents($id) == 1} { |
|
|
|
|
if {![info exists treediffs($ids)]} { |
|
|
|
|
set findids $ids |
|
|
|
|
set ffileline $l |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
set doesmatch 0 |
|
|
|
|
foreach f $treediffs($ids) { |
|
|
|
|
set x [findmatches $f] |
|
|
|
|
if {$x != {}} { |
|
|
|
|
set doesmatch 1 |
|
|
|
|
break |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
if {$doesmatch} { |
|
|
|
|
insertmatch $l $id |
|
|
|
|
set pi $nparents($id) |
|
|
|
|
} |
|
|
|
|
} else { |
|
|
|
|
set pi $nparents($id) |
|
|
|
|
} |
|
|
|
|
if {[incr pi] >= $nparents($id)} { |
|
|
|
|
set pi 0 |
|
|
|
|
if {[incr l] >= $numcommits} { |
|
|
|
|
set l 0 |
|
|
|
|
} |
|
|
|
|
if {$l == $findstartline} break |
|
|
|
|
set id $lineid($l) |
|
|
|
|
} |
|
|
|
|
set p [lindex $parents($id) $pi] |
|
|
|
|
set ids [list $id $p] |
|
|
|
|
} |
|
|
|
|
stopfindproc |
|
|
|
|
if {!$finddidsel} { |
|
|
|
|
bell |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
# mark a commit as matching by putting a yellow background |
|
|
|
|
# behind the headline |
|
|
|
|
proc markheadline {l id} { |
|
|
|
|
global canv mainfont linehtag commitinfo |
|
|
|
|
|
|
|
|
|
set bbox [$canv bbox $linehtag($l)] |
|
|
|
|
set t [$canv create rect $bbox -outline {} -tags matches -fill yellow] |
|
|
|
|
$canv lower $t |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
# mark the bits of a headline, author or date that match a find string |
|
|
|
|
proc markmatches {canv l str tag matches font} { |
|
|
|
|
set bbox [$canv bbox $tag] |
|
|
|
|
set x0 [lindex $bbox 0] |
|
|
|
@ -1255,9 +1581,10 @@ proc markmatches {canv l str tag matches font} {
@@ -1255,9 +1581,10 @@ proc markmatches {canv l str tag matches font} {
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc unmarkmatches {} { |
|
|
|
|
global matchinglines |
|
|
|
|
global matchinglines findids |
|
|
|
|
allcanvs delete matches |
|
|
|
|
catch {unset matchinglines} |
|
|
|
|
catch {unset findids} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc selcanvline {w x y} { |
|
|
|
@ -1282,8 +1609,8 @@ proc selectline {l} {
@@ -1282,8 +1609,8 @@ proc selectline {l} {
|
|
|
|
|
global canv canv2 canv3 ctext commitinfo selectedline |
|
|
|
|
global lineid linehtag linentag linedtag |
|
|
|
|
global canvy0 linespc parents nparents |
|
|
|
|
global cflist currentid sha1entry diffids |
|
|
|
|
global commentend seenfile idtags |
|
|
|
|
global cflist currentid sha1entry |
|
|
|
|
global commentend idtags |
|
|
|
|
$canv delete hover |
|
|
|
|
if {![info exists lineid($l)] || ![info exists linehtag($l)]} return |
|
|
|
|
$canv delete secsel |
|
|
|
@ -1336,7 +1663,6 @@ proc selectline {l} {
@@ -1336,7 +1663,6 @@ proc selectline {l} {
|
|
|
|
|
|
|
|
|
|
set id $lineid($l) |
|
|
|
|
set currentid $id |
|
|
|
|
set diffids [concat $id $parents($id)] |
|
|
|
|
$sha1entry delete 0 end |
|
|
|
|
$sha1entry insert 0 $id |
|
|
|
|
$sha1entry selection from 0 |
|
|
|
@ -1366,21 +1692,33 @@ proc selectline {l} {
@@ -1366,21 +1692,33 @@ proc selectline {l} {
|
|
|
|
|
|
|
|
|
|
$cflist delete 0 end |
|
|
|
|
$cflist insert end "Comments" |
|
|
|
|
if {$nparents($id) == 1} { |
|
|
|
|
startdiff |
|
|
|
|
} |
|
|
|
|
catch {unset seenfile} |
|
|
|
|
startdiff $id $parents($id) |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc startdiff {} { |
|
|
|
|
proc startdiff {id vs} { |
|
|
|
|
global diffpending diffpindex |
|
|
|
|
global diffindex difffilestart |
|
|
|
|
global curdifftag curtagstart |
|
|
|
|
|
|
|
|
|
set diffpending $vs |
|
|
|
|
set diffpindex 0 |
|
|
|
|
set diffindex 0 |
|
|
|
|
catch {unset difffilestart} |
|
|
|
|
set curdifftag Comments |
|
|
|
|
set curtagstart 0.0 |
|
|
|
|
contdiff [list $id [lindex $vs 0]] |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc contdiff {ids} { |
|
|
|
|
global treediffs diffids treepending |
|
|
|
|
|
|
|
|
|
if {![info exists treediffs($diffids)]} { |
|
|
|
|
set diffids $ids |
|
|
|
|
if {![info exists treediffs($ids)]} { |
|
|
|
|
if {![info exists treepending]} { |
|
|
|
|
gettreediffs $diffids |
|
|
|
|
gettreediffs $ids |
|
|
|
|
} |
|
|
|
|
} else { |
|
|
|
|
addtocflist $diffids |
|
|
|
|
addtocflist $ids |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
@ -1393,13 +1731,13 @@ proc selnextline {dir} {
@@ -1393,13 +1731,13 @@ proc selnextline {dir} {
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc addtocflist {ids} { |
|
|
|
|
global diffids treediffs cflist |
|
|
|
|
if {$ids != $diffids} { |
|
|
|
|
gettreediffs $diffids |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
global treediffs cflist diffpindex |
|
|
|
|
|
|
|
|
|
set colors {black blue green red cyan magenta} |
|
|
|
|
set color [lindex $colors [expr {$diffpindex % [llength $colors]}]] |
|
|
|
|
foreach f $treediffs($ids) { |
|
|
|
|
$cflist insert end $f |
|
|
|
|
$cflist itemconf end -foreground $color |
|
|
|
|
} |
|
|
|
|
getblobdiffs $ids |
|
|
|
|
} |
|
|
|
@ -1416,13 +1754,19 @@ proc gettreediffs {ids} {
@@ -1416,13 +1754,19 @@ proc gettreediffs {ids} {
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc gettreediffline {gdtf ids} { |
|
|
|
|
global treediffs treepending |
|
|
|
|
global treediffs treepending diffids |
|
|
|
|
set n [gets $gdtf line] |
|
|
|
|
if {$n < 0} { |
|
|
|
|
if {![eof $gdtf]} return |
|
|
|
|
close $gdtf |
|
|
|
|
unset treepending |
|
|
|
|
addtocflist $ids |
|
|
|
|
if {[info exists diffids]} { |
|
|
|
|
if {$ids != $diffids} { |
|
|
|
|
gettreediffs $diffids |
|
|
|
|
} else { |
|
|
|
|
addtocflist $ids |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
set file [lindex $line 5] |
|
|
|
@ -1430,8 +1774,8 @@ proc gettreediffline {gdtf ids} {
@@ -1430,8 +1774,8 @@ proc gettreediffline {gdtf ids} {
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc getblobdiffs {ids} { |
|
|
|
|
global diffopts blobdifffd env curdifftag curtagstart |
|
|
|
|
global diffindex difffilestart nextupdate |
|
|
|
|
global diffopts blobdifffd diffids env |
|
|
|
|
global nextupdate diffinhdr |
|
|
|
|
|
|
|
|
|
set id [lindex $ids 0] |
|
|
|
|
set p [lindex $ids 1] |
|
|
|
@ -1440,20 +1784,18 @@ proc getblobdiffs {ids} {
@@ -1440,20 +1784,18 @@ proc getblobdiffs {ids} {
|
|
|
|
|
puts "error getting diffs: $err" |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
set diffinhdr 0 |
|
|
|
|
fconfigure $bdf -blocking 0 |
|
|
|
|
set blobdifffd($ids) $bdf |
|
|
|
|
set curdifftag Comments |
|
|
|
|
set curtagstart 0.0 |
|
|
|
|
set diffindex 0 |
|
|
|
|
catch {unset difffilestart} |
|
|
|
|
fileevent $bdf readable "getblobdiffline $bdf {$ids}" |
|
|
|
|
fileevent $bdf readable [list getblobdiffline $bdf $ids] |
|
|
|
|
set nextupdate [expr {[clock clicks -milliseconds] + 100}] |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc getblobdiffline {bdf ids} { |
|
|
|
|
global diffids blobdifffd ctext curdifftag curtagstart seenfile |
|
|
|
|
global diffids blobdifffd ctext curdifftag curtagstart |
|
|
|
|
global diffnexthead diffnextnote diffindex difffilestart |
|
|
|
|
global nextupdate |
|
|
|
|
global nextupdate diffpending diffpindex diffinhdr |
|
|
|
|
global gaudydiff |
|
|
|
|
|
|
|
|
|
set n [gets $bdf line] |
|
|
|
|
if {$n < 0} { |
|
|
|
@ -1461,7 +1803,11 @@ proc getblobdiffline {bdf ids} {
@@ -1461,7 +1803,11 @@ proc getblobdiffline {bdf ids} {
|
|
|
|
|
close $bdf |
|
|
|
|
if {$ids == $diffids && $bdf == $blobdifffd($ids)} { |
|
|
|
|
$ctext tag add $curdifftag $curtagstart end |
|
|
|
|
set seenfile($curdifftag) 1 |
|
|
|
|
if {[incr diffpindex] < [llength $diffpending]} { |
|
|
|
|
set id [lindex $ids 0] |
|
|
|
|
set p [lindex $diffpending $diffpindex] |
|
|
|
|
contdiff [list $id $p] |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
return |
|
|
|
@ -1470,18 +1816,12 @@ proc getblobdiffline {bdf ids} {
@@ -1470,18 +1816,12 @@ proc getblobdiffline {bdf ids} {
|
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
$ctext conf -state normal |
|
|
|
|
if {[regexp {^---[ \t]+([^/])*/(.*)} $line match s1 fname]} { |
|
|
|
|
if {[regexp {^diff --git a/(.*) b/} $line match fname]} { |
|
|
|
|
# start of a new file |
|
|
|
|
$ctext insert end "\n" |
|
|
|
|
$ctext tag add $curdifftag $curtagstart end |
|
|
|
|
set seenfile($curdifftag) 1 |
|
|
|
|
set curtagstart [$ctext index "end - 1c"] |
|
|
|
|
set header $fname |
|
|
|
|
if {[info exists diffnexthead]} { |
|
|
|
|
set fname $diffnexthead |
|
|
|
|
set header "$diffnexthead ($diffnextnote)" |
|
|
|
|
unset diffnexthead |
|
|
|
|
} |
|
|
|
|
set here [$ctext index "end - 1c"] |
|
|
|
|
set difffilestart($diffindex) $here |
|
|
|
|
incr diffindex |
|
|
|
@ -1493,37 +1833,33 @@ proc getblobdiffline {bdf ids} {
@@ -1493,37 +1833,33 @@ proc getblobdiffline {bdf ids} {
|
|
|
|
|
set l [expr {(78 - [string length $header]) / 2}] |
|
|
|
|
set pad [string range "----------------------------------------" 1 $l] |
|
|
|
|
$ctext insert end "$pad $header $pad\n" filesep |
|
|
|
|
} elseif {[string range $line 0 2] == "+++"} { |
|
|
|
|
# no need to do anything with this |
|
|
|
|
} elseif {[regexp {^Created: (.*) \((mode: *[0-7]*)\)} $line match fn m]} { |
|
|
|
|
set diffnexthead $fn |
|
|
|
|
set diffnextnote "created, mode $m" |
|
|
|
|
} elseif {[string range $line 0 8] == "Deleted: "} { |
|
|
|
|
set diffnexthead [string range $line 9 end] |
|
|
|
|
set diffnextnote "deleted" |
|
|
|
|
} elseif {[regexp {^diff --git a/(.*) b/} $line match fn]} { |
|
|
|
|
# save the filename in case the next thing is "new file mode ..." |
|
|
|
|
set diffnexthead $fn |
|
|
|
|
set diffnextnote "modified" |
|
|
|
|
} elseif {[regexp {^new file mode ([0-7]+)} $line match m]} { |
|
|
|
|
set diffnextnote "new file, mode $m" |
|
|
|
|
} elseif {[string range $line 0 11] == "deleted file"} { |
|
|
|
|
set diffnextnote "deleted" |
|
|
|
|
set diffinhdr 1 |
|
|
|
|
} elseif {[regexp {^(---|\+\+\+)} $line]} { |
|
|
|
|
set diffinhdr 0 |
|
|
|
|
} elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \ |
|
|
|
|
$line match f1l f1c f2l f2c rest]} { |
|
|
|
|
$ctext insert end "\t" hunksep |
|
|
|
|
$ctext insert end " $f1l " d0 " $f2l " d1 |
|
|
|
|
$ctext insert end " $rest \n" hunksep |
|
|
|
|
if {$gaudydiff} { |
|
|
|
|
$ctext insert end "\t" hunksep |
|
|
|
|
$ctext insert end " $f1l " d0 " $f2l " d1 |
|
|
|
|
$ctext insert end " $rest \n" hunksep |
|
|
|
|
} else { |
|
|
|
|
$ctext insert end "$line\n" hunksep |
|
|
|
|
} |
|
|
|
|
set diffinhdr 0 |
|
|
|
|
} else { |
|
|
|
|
set x [string range $line 0 0] |
|
|
|
|
if {$x == "-" || $x == "+"} { |
|
|
|
|
set tag [expr {$x == "+"}] |
|
|
|
|
set line [string range $line 1 end] |
|
|
|
|
if {$gaudydiff} { |
|
|
|
|
set line [string range $line 1 end] |
|
|
|
|
} |
|
|
|
|
$ctext insert end "$line\n" d$tag |
|
|
|
|
} elseif {$x == " "} { |
|
|
|
|
set line [string range $line 1 end] |
|
|
|
|
if {$gaudydiff} { |
|
|
|
|
set line [string range $line 1 end] |
|
|
|
|
} |
|
|
|
|
$ctext insert end "$line\n" |
|
|
|
|
} elseif {$x == "\\"} { |
|
|
|
|
} elseif {$diffinhdr || $x == "\\"} { |
|
|
|
|
# e.g. "\ No newline at end of file" |
|
|
|
|
$ctext insert end "$line\n" filesep |
|
|
|
|
} else { |
|
|
|
@ -1531,7 +1867,6 @@ proc getblobdiffline {bdf ids} {
@@ -1531,7 +1867,6 @@ proc getblobdiffline {bdf ids} {
|
|
|
|
|
if {$curdifftag != "Comments"} { |
|
|
|
|
$ctext insert end "\n" |
|
|
|
|
$ctext tag add $curdifftag $curtagstart end |
|
|
|
|
set seenfile($curdifftag) 1 |
|
|
|
|
set curtagstart [$ctext index "end - 1c"] |
|
|
|
|
set curdifftag Comments |
|
|
|
|
} |
|
|
|
@ -1559,7 +1894,7 @@ proc nextfile {} {
@@ -1559,7 +1894,7 @@ proc nextfile {} {
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc listboxsel {} { |
|
|
|
|
global ctext cflist currentid treediffs seenfile |
|
|
|
|
global ctext cflist currentid treediffs |
|
|
|
|
if {![info exists currentid]} return |
|
|
|
|
set sel [lsort [$cflist curselection]] |
|
|
|
|
if {$sel eq {}} return |
|
|
|
@ -1631,18 +1966,35 @@ proc sha1change {n1 n2 op} {
@@ -1631,18 +1966,35 @@ proc sha1change {n1 n2 op} {
|
|
|
|
|
|
|
|
|
|
proc gotocommit {} { |
|
|
|
|
global sha1string currentid idline tagids |
|
|
|
|
global lineid numcommits |
|
|
|
|
|
|
|
|
|
if {$sha1string == {} |
|
|
|
|
|| ([info exists currentid] && $sha1string == $currentid)} return |
|
|
|
|
if {[info exists tagids($sha1string)]} { |
|
|
|
|
set id $tagids($sha1string) |
|
|
|
|
} else { |
|
|
|
|
set id [string tolower $sha1string] |
|
|
|
|
if {[regexp {^[0-9a-f]{4,39}$} $id]} { |
|
|
|
|
set matches {} |
|
|
|
|
for {set l 0} {$l < $numcommits} {incr l} { |
|
|
|
|
if {[string match $id* $lineid($l)]} { |
|
|
|
|
lappend matches $lineid($l) |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
if {$matches ne {}} { |
|
|
|
|
if {[llength $matches] > 1} { |
|
|
|
|
error_popup "Short SHA1 id $id is ambiguous" |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
set id [lindex $matches 0] |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
if {[info exists idline($id)]} { |
|
|
|
|
selectline $idline($id) |
|
|
|
|
return |
|
|
|
|
} |
|
|
|
|
if {[regexp {^[0-9a-fA-F]{40}$} $sha1string]} { |
|
|
|
|
if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} { |
|
|
|
|
set type "SHA1 id" |
|
|
|
|
} else { |
|
|
|
|
set type "Tag" |
|
|
|
@ -1781,7 +2133,7 @@ proc rowmenu {x y id} {
@@ -1781,7 +2133,7 @@ proc rowmenu {x y id} {
|
|
|
|
|
proc diffvssel {dirn} { |
|
|
|
|
global rowmenuid selectedline lineid |
|
|
|
|
global ctext cflist |
|
|
|
|
global diffids commitinfo |
|
|
|
|
global commitinfo |
|
|
|
|
|
|
|
|
|
if {![info exists selectedline]} return |
|
|
|
|
if {$dirn} { |
|
|
|
@ -1805,8 +2157,7 @@ proc diffvssel {dirn} {
@@ -1805,8 +2157,7 @@ proc diffvssel {dirn} {
|
|
|
|
|
$ctext conf -state disabled |
|
|
|
|
$ctext tag delete Comments |
|
|
|
|
$ctext tag remove found 1.0 end |
|
|
|
|
set diffids [list $newid $oldid] |
|
|
|
|
startdiff |
|
|
|
|
startdiff [list $newid $oldid] |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
proc mkpatch {} { |
|
|
|
@ -2044,6 +2395,8 @@ set wrcomcmd "git-diff-tree --stdin -p --pretty"
@@ -2044,6 +2395,8 @@ set wrcomcmd "git-diff-tree --stdin -p --pretty"
|
|
|
|
|
|
|
|
|
|
set mainfont {Helvetica 9} |
|
|
|
|
set textfont {Courier 9} |
|
|
|
|
set findmergefiles 0 |
|
|
|
|
set gaudydiff 0 |
|
|
|
|
|
|
|
|
|
set colors {green red blue magenta darkgrey brown orange} |
|
|
|
|
|
|
|
|
|