exit 1
}
set leftover {}
- fconfigure $commfd -blocking 0 -translation binary
+ fconfigure $commfd -blocking 0 -translation lf
fileevent $commfd readable "getcommitlines $commfd"
$canv delete all
$canv create text 3 3 -anchor nw -text "Reading commits..." \
-font $mainfont -tags textitems
. config -cursor watch
- $ctext config -cursor watch
+ settextcursor watch
}
proc getcommitlines {commfd} {
global canv canv2 canv3 linespc charspc ctext cflist textfont
global findtype findtypemenu findloc findstring fstring geometry
global entries sha1entry sha1string sha1but
- global maincursor textcursor
+ global maincursor textcursor curtextcursor
global rowctxmenu gaudydiff mergemax
menu .bar
entry $sha1entry -width 40 -font $textfont -textvariable sha1string
trace add variable sha1string write sha1change
pack $sha1entry -side left -pady 2
+
+ image create bitmap bm-left -data {
+ #define left_width 16
+ #define left_height 16
+ static unsigned char left_bits[] = {
+ 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
+ 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
+ 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
+ }
+ image create bitmap bm-right -data {
+ #define right_width 16
+ #define right_height 16
+ static unsigned char right_bits[] = {
+ 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
+ 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
+ 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
+ }
+ button .ctop.top.bar.leftbut -image bm-left -command goback \
+ -state disabled -width 26
+ pack .ctop.top.bar.leftbut -side left -fill y
+ button .ctop.top.bar.rightbut -image bm-right -command goforw \
+ -state disabled -width 26
+ pack .ctop.top.bar.rightbut -side left -fill y
+
button .ctop.top.bar.findbut -text "Find" -command dofind
pack .ctop.top.bar.findbut -side left
set findstring {}
set maincursor [. cget -cursor]
set textcursor [$ctext cget -cursor]
+ set curtextcursor $textcursor
set rowctxmenu .rowctxmenu
menu $rowctxmenu -tearoff 0
proc savestuff {w} {
global canv canv2 canv3 ctext cflist mainfont textfont
- global stuffsaved findmergefiles gaudydiff
+ global stuffsaved findmergefiles gaudydiff maxgraphpct
if {$stuffsaved} return
if {![winfo viewable .]} return
puts $f [list set textfont $textfont]
puts $f [list set findmergefiles $findmergefiles]
puts $f [list set gaudydiff $gaudydiff]
+ puts $f [list set maxgraphpct $maxgraphpct]
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]"
proc drawcommitline {level} {
global parents children nparents nchildren todo
- global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
+ global canv canv2 canv3 mainfont namefont canvy linespc
global lineid linehtag linentag linedtag commitinfo
global colormap numcommits currentparents dupparents
global oldlevel oldnlines oldtodo
}
}
}
- set x [expr $canvx0 + $level * $linespc]
+ set x [xcoord $level $level $lineno]
set y1 $canvy
set canvy [expr $canvy + $linespc]
allcanvs conf -scrollregion \
-fill $ofill -outline black -width 1]
$canv raise $t
$canv bind $t <1> {selcanvline {} %x %y}
- set xt [expr $canvx0 + [llength $todo] * $linespc]
+ set xt [xcoord [llength $todo] $level $lineno]
if {[llength $currentparents] > 2} {
set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
}
proc updatetodo {level noshortcut} {
global currentparents ncleft todo
global mainline oldlevel oldtodo oldnlines
- global canvx0 canvy linespc mainline
- global commitinfo
+ global canvy linespc mainline
+ global commitinfo lineno xspc1
set oldlevel $level
set oldtodo $todo
set p [lindex $currentparents 0]
if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
set ncleft($p) 0
- set x [expr $canvx0 + $level * $linespc]
+ set x [xcoord $level $level $lineno]
set y [expr $canvy - $linespc]
set mainline($p) [list $x $y]
set todo [lreplace $todo $level $level $p]
+ set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
return 0
}
}
}
}
-proc drawslants {} {
- global canv mainline sidelines canvx0 canvy linespc
- global oldlevel oldtodo todo currentparents dupparents
- global lthickness linespc canvy colormap
+proc xcoord {i level ln} {
+ global canvx0 xspc1 xspc2
+
+ set x [expr {$canvx0 + $i * $xspc1($ln)}]
+ if {$i > 0 && $i == $level} {
+ set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
+ } elseif {$i > $level} {
+ set x [expr {$x + $xspc2 - $xspc1($ln)}]
+ }
+ return $x
+}
+proc drawslants {level} {
+ global canv mainline sidelines canvx0 canvy xspc1 xspc2 lthickness
+ global oldlevel oldtodo todo currentparents dupparents
+ global lthickness linespc canvy colormap lineno geometry
+ global maxgraphpct
+
+ # decide on the line spacing for the next line
+ set lj [expr {$lineno + 1}]
+ set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
+ set n [llength $todo]
+ if {$n <= 1 || $canvx0 + $n * $xspc2 <= $maxw} {
+ set xspc1($lj) $xspc2
+ } else {
+ set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($n - 1)}]
+ if {$xspc1($lj) < $lthickness} {
+ set xspc1($lj) $lthickness
+ }
+ }
+
set y1 [expr $canvy - $linespc]
set y2 $canvy
set i -1
foreach id $oldtodo {
incr i
if {$id == {}} continue
- set xi [expr {$canvx0 + $i * $linespc}]
+ set xi [xcoord $i $oldlevel $lineno]
if {$i == $oldlevel} {
foreach p $currentparents {
set j [lsearch -exact $todo $p]
set coords [list $xi $y1]
- set xj [expr {$canvx0 + $j * $linespc}]
- if {$j < $i - 1} {
- lappend coords [expr $xj + $linespc] $y1
+ set xj [xcoord $j $level $lj]
+ if {$xj < $xi - $linespc} {
+ lappend coords [expr {$xj + $linespc}] $y1
notecrossings $p $j $i [expr {$j + 1}]
- } elseif {$j > $i + 1} {
- lappend coords [expr $xj - $linespc] $y1
+ } elseif {$xj > $xi + $linespc} {
+ lappend coords [expr {$xj - $linespc}] $y1
notecrossings $p $i $j [expr {$j - 1}]
}
if {[lsearch -exact $dupparents $p] >= 0} {
}
} else {
# normal case, no parent duplicated
+ set yb $y2
+ set dx [expr {abs($xi - $xj)}]
+ if {0 && $dx < $linespc} {
+ set yb [expr {$y1 + $dx}]
+ }
if {![info exists mainline($p)]} {
- if {$i != $j} {
- lappend coords $xj $y2
+ if {$xi != $xj} {
+ lappend coords $xj $yb
}
set mainline($p) $coords
} else {
- lappend coords $xj $y2
+ lappend coords $xj $yb
+ if {$yb < $y2} {
+ lappend coords $xj $y2
+ }
lappend sidelines($p) [list $coords 1]
}
}
}
- } elseif {[lindex $todo $i] != $id} {
- set j [lsearch -exact $todo $id]
- set xj [expr {$canvx0 + $j * $linespc}]
- lappend mainline($id) $xi $y1 $xj $y2
+ } else {
+ set j $i
+ if {[lindex $todo $i] != $id} {
+ set j [lsearch -exact $todo $id]
+ }
+ if {$j != $i || $xspc1($lineno) != $xspc1($lj)
+ || ($oldlevel <= $i && $i <= $level)
+ || ($level <= $i && $i <= $oldlevel)} {
+ set xj [xcoord $j $level $lj]
+ set dx [expr {abs($xi - $xj)}]
+ set yb $y2
+ if {0 && $dx < $linespc} {
+ set yb [expr {$y1 + $dx}]
+ }
+ lappend mainline($id) $xi $y1 $xj $yb
+ }
}
}
}
proc decidenext {{noread 0}} {
global parents children nchildren ncleft todo
- global canv canv2 canv3 mainfont namefont canvx0 canvy linespc
+ global canv canv2 canv3 mainfont namefont canvy linespc
global datemode cdate
global commitinfo
global currentparents oldlevel oldnlines oldtodo
return
}
while 1 {
- drawslants
+ drawslants $level
drawcommitline $level
if {[updatetodo $level $datemode]} {
set level [decidenext 1]
-font $mainfont -tags textitems
set phase {}
} else {
- drawslants
set level [decidenext]
+ drawslants $level
drawrest $level [llength $startcommits]
}
. config -cursor $maincursor
- $ctext config -cursor $textcursor
+ settextcursor $textcursor
+}
+
+# Don't change the text pane cursor if it is currently the hand cursor,
+# showing that we are over a sha1 ID link.
+proc settextcursor {c} {
+ global ctext curtextcursor
+
+ if {[$ctext cget -cursor] == $curtextcursor} {
+ $ctext config -cursor $c
+ }
+ set curtextcursor $c
}
proc drawgraph {} {
if {$hard} {
set level [decidenext]
if {$level < 0} break
- drawslants
+ drawslants $level
}
if {[clock clicks -milliseconds] >= $nextupdate} {
update
#puts "overall $drawmsecs ms for $numcommits commits"
if {$redisplaying} {
if {$stopped == 0 && [info exists selectedline]} {
- selectline $selectedline
+ selectline $selectedline 0
}
if {$stopped == 1} {
set stopped 0
proc findselectline {l} {
global findloc commentend ctext
- selectline $l
+ selectline $l 1
if {$findloc == "All fields" || $findloc == "Comments"} {
# highlight the matches in the comments
set f [$ctext get 1.0 $commentend]
unset findinprogress
if {$phase != "incrdraw"} {
. config -cursor $maincursor
- $ctext config -cursor $textcursor
+ settextcursor $textcursor
}
}
}
fileevent $f readable readfindproc
set finddidsel 0
. config -cursor watch
- $ctext config -cursor watch
+ settextcursor watch
set findinprogress 1
}
set id $lineid($l)
set p [lindex $parents($id) 0]
. config -cursor watch
- $ctext config -cursor watch
+ settextcursor watch
set findinprogress 1
findcont [list $id $p]
update
if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
}
unmarkmatches
- selectline $l
+ selectline $l 1
}
-proc selectline {l} {
+proc selectline {l isnew} {
global canv canv2 canv3 ctext commitinfo selectedline
global lineid linehtag linentag linedtag
global canvy0 linespc parents nparents
global cflist currentid sha1entry
- global commentend idtags
+ global commentend idtags idline
+ global history historyindex
+
$canv delete hover
if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
$canv delete secsel
}
allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
}
+
+ if {$isnew && (![info exists selectedline] || $selectedline != $l)} {
+ if {$historyindex < [llength $history]} {
+ set history [lreplace $history $historyindex end $l]
+ } else {
+ lappend history $l
+ }
+ incr historyindex
+ if {$historyindex > 1} {
+ .ctop.top.bar.leftbut conf -state normal
+ } else {
+ .ctop.top.bar.leftbut conf -state disabled
+ }
+ .ctop.top.bar.rightbut conf -state disabled
+ }
+
set selectedline $l
set id $lineid($l)
$ctext insert end "\n"
}
$ctext insert end "\n"
- $ctext insert end [lindex $info 5]
+ set commentstart [$ctext index "end - 1c"]
+ set comment [lindex $info 5]
+ $ctext insert end $comment
$ctext insert end "\n"
+
+ # make anything that looks like a SHA1 ID be a clickable link
+ set links [regexp -indices -all -inline {[0-9a-f]{40}} $comment]
+ set i 0
+ foreach l $links {
+ set s [lindex $l 0]
+ set e [lindex $l 1]
+ set linkid [string range $comment $s $e]
+ if {![info exists idline($linkid)]} continue
+ incr e
+ $ctext tag add link "$commentstart + $s c" "$commentstart + $e c"
+ $ctext tag add link$i "$commentstart + $s c" "$commentstart + $e c"
+ $ctext tag bind link$i <1> [list selectline $idline($linkid) 1]
+ incr i
+ }
+ $ctext tag conf link -foreground blue -underline 1
+ $ctext tag bind link <Enter> { %W configure -cursor hand2 }
+ $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
+
$ctext tag delete Comments
$ctext tag remove found 1.0 end
$ctext conf -state disabled
if {![info exists selectedline]} return
set l [expr $selectedline + $dir]
unmarkmatches
- selectline $l
+ selectline $l 1
+}
+
+proc goback {} {
+ global history historyindex
+
+ if {$historyindex > 1} {
+ incr historyindex -1
+ selectline [lindex $history [expr {$historyindex - 1}]] 0
+ .ctop.top.bar.rightbut conf -state normal
+ }
+ if {$historyindex <= 1} {
+ .ctop.top.bar.leftbut conf -state disabled
+ }
+}
+
+proc goforw {} {
+ global history historyindex
+
+ if {$historyindex < [llength $history]} {
+ set l [lindex $history $historyindex]
+ incr historyindex
+ selectline $l 0
+ .ctop.top.bar.leftbut conf -state normal
+ }
+ if {$historyindex >= [llength $history]} {
+ .ctop.top.bar.rightbut conf -state disabled
+ }
}
proc mergediff {id} {
proc setcoords {} {
global linespc charspc canvx0 canvy0 mainfont
+ global xspc1 xspc2
+
set linespc [font metrics $mainfont -linespace]
set charspc [font measure $mainfont "m"]
set canvy0 [expr 3 + 0.5 * $linespc]
set canvx0 [expr 3 + 0.5 * $linespc]
+ set xspc1(0) $linespc
+ set xspc2 $linespc
}
proc redisplay {} {
}
}
if {[info exists idline($id)]} {
- selectline $idline($id)
+ selectline $idline($id) 1
return
}
if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
proc selbyid {id} {
global idline
if {[info exists idline($id)]} {
- selectline $idline($id)
+ selectline $idline($id) 1
}
}
set xt [eval drawtags $id $idpos($id)]
$canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
if {[info exists selectedline] && $selectedline == $idline($id)} {
- selectline $selectedline
+ selectline $selectedline 0
}
}
set textfont {Courier 9}
set findmergefiles 0
set gaudydiff 0
+set maxgraphpct 50
set colors {green red blue magenta darkgrey brown orange}
}
}
+set history {}
+set historyindex 0
+
set stopped 0
set redisplaying 0
set stuffsaved 0
projects / git.git / blobdiff