+proc clearsha1 {} {
+ global sha1entry sha1string
+ if {[string length $sha1string] == 40} {
+ $sha1entry delete 0 end
+ }
+}
+
+proc sha1change {n1 n2 op} {
+ global sha1string currentid sha1but
+ if {$sha1string == {}
+ || ([info exists currentid] && $sha1string == $currentid)} {
+ set state disabled
+ } else {
+ set state normal
+ }
+ if {[$sha1but cget -state] == $state} return
+ if {$state == "normal"} {
+ $sha1but conf -state normal -relief raised -text "Goto: "
+ } else {
+ $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
+ }
+}
+
+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) 1
+ return
+ }
+ if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
+ set type "SHA1 id"
+ } else {
+ set type "Tag"
+ }
+ error_popup "$type $sha1string is not known"
+}
+
+proc lineenter {x y id} {
+ global hoverx hovery hoverid hovertimer
+ global commitinfo canv
+
+ if {![info exists commitinfo($id)]} return
+ set hoverx $x
+ set hovery $y
+ set hoverid $id
+ if {[info exists hovertimer]} {
+ after cancel $hovertimer
+ }
+ set hovertimer [after 500 linehover]
+ $canv delete hover
+}
+
+proc linemotion {x y id} {
+ global hoverx hovery hoverid hovertimer
+
+ if {[info exists hoverid] && $id == $hoverid} {
+ set hoverx $x
+ set hovery $y
+ if {[info exists hovertimer]} {
+ after cancel $hovertimer
+ }
+ set hovertimer [after 500 linehover]
+ }
+}
+
+proc lineleave {id} {
+ global hoverid hovertimer canv
+
+ if {[info exists hoverid] && $id == $hoverid} {
+ $canv delete hover
+ if {[info exists hovertimer]} {
+ after cancel $hovertimer
+ unset hovertimer
+ }
+ unset hoverid
+ }
+}
+
+proc linehover {} {
+ global hoverx hovery hoverid hovertimer
+ global canv linespc lthickness
+ global commitinfo mainfont
+
+ set text [lindex $commitinfo($hoverid) 0]
+ set ymax [lindex [$canv cget -scrollregion] 3]
+ if {$ymax == {}} return
+ set yfrac [lindex [$canv yview] 0]
+ set x [expr {$hoverx + 2 * $linespc}]
+ set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
+ set x0 [expr {$x - 2 * $lthickness}]
+ set y0 [expr {$y - 2 * $lthickness}]
+ set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
+ set y1 [expr {$y + $linespc + 2 * $lthickness}]
+ set t [$canv create rectangle $x0 $y0 $x1 $y1 \
+ -fill \#ffff80 -outline black -width 1 -tags hover]
+ $canv raise $t
+ set t [$canv create text $x $y -anchor nw -text $text -tags hover]
+ $canv raise $t
+}
+
+proc clickisonarrow {id y} {
+ global mainline mainlinearrow sidelines lthickness
+
+ set thresh [expr {2 * $lthickness + 6}]
+ if {[info exists mainline($id)]} {
+ if {$mainlinearrow($id) ne "none"} {
+ if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
+ return "up"
+ }
+ }
+ }
+ if {[info exists sidelines($id)]} {
+ foreach ls $sidelines($id) {
+ set coords [lindex $ls 0]
+ set arrow [lindex $ls 2]
+ if {$arrow eq "first" || $arrow eq "both"} {
+ if {abs([lindex $coords 1] - $y) < $thresh} {
+ return "up"
+ }
+ }
+ if {$arrow eq "last" || $arrow eq "both"} {
+ if {abs([lindex $coords end] - $y) < $thresh} {
+ return "down"
+ }
+ }
+ }
+ }
+ return {}
+}
+
+proc arrowjump {id dirn y} {
+ global mainline sidelines canv
+
+ set yt {}
+ if {$dirn eq "down"} {
+ if {[info exists mainline($id)]} {
+ set y1 [lindex $mainline($id) 1]
+ if {$y1 > $y} {
+ set yt $y1
+ }
+ }
+ if {[info exists sidelines($id)]} {
+ foreach ls $sidelines($id) {
+ set y1 [lindex $ls 0 1]
+ if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
+ set yt $y1
+ }
+ }
+ }
+ } else {
+ if {[info exists sidelines($id)]} {
+ foreach ls $sidelines($id) {
+ set y1 [lindex $ls 0 end]
+ if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
+ set yt $y1
+ }
+ }
+ }
+ }
+ if {$yt eq {}} return
+ set ymax [lindex [$canv cget -scrollregion] 3]
+ if {$ymax eq {} || $ymax <= 0} return
+ set view [$canv yview]
+ set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
+ set yfrac [expr {$yt / $ymax - $yspan / 2}]
+ if {$yfrac < 0} {
+ set yfrac 0
+ }
+ $canv yview moveto $yfrac
+}
+
+proc lineclick {x y id isnew} {
+ global ctext commitinfo children cflist canv thickerline
+
+ unmarkmatches
+ unselectline
+ normalline
+ $canv delete hover
+ # draw this line thicker than normal
+ drawlines $id 1
+ set thickerline $id
+ if {$isnew} {
+ set ymax [lindex [$canv cget -scrollregion] 3]
+ if {$ymax eq {}} return
+ set yfrac [lindex [$canv yview] 0]
+ set y [expr {$y + $yfrac * $ymax}]
+ }
+ set dirn [clickisonarrow $id $y]
+ if {$dirn ne {}} {
+ arrowjump $id $dirn $y
+ return
+ }
+
+ if {$isnew} {
+ addtohistory [list lineclick $x $y $id 0]
+ }
+ # fill the details pane with info about this line
+ $ctext conf -state normal
+ $ctext delete 0.0 end
+ $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 insert end "Parent:\t"
+ $ctext insert end $id [list link link0]
+ $ctext tag bind link0 <1> [list selbyid $id]
+ set info $commitinfo($id)
+ $ctext insert end "\n\t[lindex $info 0]\n"
+ $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
+ $ctext insert end "\tDate:\t[lindex $info 2]\n"
+ if {[info exists children($id)]} {
+ $ctext insert end "\nChildren:"
+ set i 0
+ foreach child $children($id) {
+ incr i
+ set info $commitinfo($child)
+ $ctext insert end "\n\t"
+ $ctext insert end $child [list link link$i]
+ $ctext tag bind link$i <1> [list selbyid $child]
+ $ctext insert end "\n\t[lindex $info 0]"
+ $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
+ $ctext insert end "\n\tDate:\t[lindex $info 2]\n"
+ }
+ }
+ $ctext conf -state disabled
+
+ $cflist delete 0 end
+}
+
+proc normalline {} {
+ global thickerline
+ if {[info exists thickerline]} {
+ drawlines $thickerline 0
+ unset thickerline
+ }
+}
+
+proc selbyid {id} {
+ global idline
+ if {[info exists idline($id)]} {
+ selectline $idline($id) 1
+ }
+}
+
+proc mstime {} {
+ global startmstime
+ if {![info exists startmstime]} {
+ set startmstime [clock clicks -milliseconds]
+ }
+ return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
+}
+
+proc rowmenu {x y id} {
+ global rowctxmenu idline selectedline rowmenuid
+
+ if {![info exists selectedline] || $idline($id) eq $selectedline} {
+ set state disabled
+ } else {
+ set state normal
+ }
+ $rowctxmenu entryconfigure 0 -state $state
+ $rowctxmenu entryconfigure 1 -state $state
+ $rowctxmenu entryconfigure 2 -state $state
+ set rowmenuid $id
+ tk_popup $rowctxmenu $x $y
+}
+
+proc diffvssel {dirn} {
+ global rowmenuid selectedline lineid
+
+ if {![info exists selectedline]} return
+ if {$dirn} {
+ set oldid $lineid($selectedline)
+ set newid $rowmenuid
+ } else {
+ set oldid $rowmenuid
+ set newid $lineid($selectedline)
+ }
+ addtohistory [list doseldiff $oldid $newid]
+ doseldiff $oldid $newid
+}
+
+proc doseldiff {oldid newid} {
+ global ctext cflist
+ global commitinfo
+
+ $ctext conf -state normal
+ $ctext delete 0.0 end
+ $ctext mark set fmark.0 0.0
+ $ctext mark gravity fmark.0 left
+ $cflist delete 0 end
+ $cflist insert end "Top"
+ $ctext insert end "From "
+ $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 bind link0 <1> [list selbyid $oldid]
+ $ctext insert end $oldid [list link link0]
+ $ctext insert end "\n "
+ $ctext insert end [lindex $commitinfo($oldid) 0]
+ $ctext insert end "\n\nTo "
+ $ctext tag bind link1 <1> [list selbyid $newid]
+ $ctext insert end $newid [list link link1]
+ $ctext insert end "\n "
+ $ctext insert end [lindex $commitinfo($newid) 0]
+ $ctext insert end "\n"
+ $ctext conf -state disabled
+ $ctext tag delete Comments
+ $ctext tag remove found 1.0 end
+ startdiff [list $newid $oldid]
+}
+
+proc mkpatch {} {
+ global rowmenuid currentid commitinfo patchtop patchnum
+
+ if {![info exists currentid]} return
+ set oldid $currentid
+ set oldhead [lindex $commitinfo($oldid) 0]
+ set newid $rowmenuid
+ set newhead [lindex $commitinfo($newid) 0]
+ set top .patch
+ set patchtop $top
+ catch {destroy $top}
+ toplevel $top
+ label $top.title -text "Generate patch"
+ grid $top.title - -pady 10
+ label $top.from -text "From:"
+ entry $top.fromsha1 -width 40 -relief flat
+ $top.fromsha1 insert 0 $oldid
+ $top.fromsha1 conf -state readonly
+ grid $top.from $top.fromsha1 -sticky w
+ entry $top.fromhead -width 60 -relief flat
+ $top.fromhead insert 0 $oldhead
+ $top.fromhead conf -state readonly
+ grid x $top.fromhead -sticky w
+ label $top.to -text "To:"
+ entry $top.tosha1 -width 40 -relief flat
+ $top.tosha1 insert 0 $newid
+ $top.tosha1 conf -state readonly
+ grid $top.to $top.tosha1 -sticky w
+ entry $top.tohead -width 60 -relief flat
+ $top.tohead insert 0 $newhead
+ $top.tohead conf -state readonly
+ grid x $top.tohead -sticky w
+ button $top.rev -text "Reverse" -command mkpatchrev -padx 5
+ grid $top.rev x -pady 10
+ label $top.flab -text "Output file:"
+ entry $top.fname -width 60
+ $top.fname insert 0 [file normalize "patch$patchnum.patch"]
+ incr patchnum
+ grid $top.flab $top.fname -sticky w
+ frame $top.buts
+ button $top.buts.gen -text "Generate" -command mkpatchgo
+ button $top.buts.can -text "Cancel" -command mkpatchcan
+ grid $top.buts.gen $top.buts.can
+ grid columnconfigure $top.buts 0 -weight 1 -uniform a
+ grid columnconfigure $top.buts 1 -weight 1 -uniform a
+ grid $top.buts - -pady 10 -sticky ew
+ focus $top.fname
+}
+
+proc mkpatchrev {} {
+ global patchtop
+
+ set oldid [$patchtop.fromsha1 get]
+ set oldhead [$patchtop.fromhead get]
+ set newid [$patchtop.tosha1 get]
+ set newhead [$patchtop.tohead get]
+ foreach e [list fromsha1 fromhead tosha1 tohead] \
+ v [list $newid $newhead $oldid $oldhead] {
+ $patchtop.$e conf -state normal
+ $patchtop.$e delete 0 end
+ $patchtop.$e insert 0 $v
+ $patchtop.$e conf -state readonly
+ }
+}
+
+proc mkpatchgo {} {
+ global patchtop
+
+ set oldid [$patchtop.fromsha1 get]
+ set newid [$patchtop.tosha1 get]
+ set fname [$patchtop.fname get]
+ if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
+ error_popup "Error creating patch: $err"
+ }
+ catch {destroy $patchtop}
+ unset patchtop
+}
+
+proc mkpatchcan {} {
+ global patchtop
+
+ catch {destroy $patchtop}
+ unset patchtop
+}
+
+proc mktag {} {
+ global rowmenuid mktagtop commitinfo
+
+ set top .maketag
+ set mktagtop $top
+ catch {destroy $top}
+ toplevel $top
+ label $top.title -text "Create tag"
+ grid $top.title - -pady 10
+ label $top.id -text "ID:"
+ entry $top.sha1 -width 40 -relief flat
+ $top.sha1 insert 0 $rowmenuid
+ $top.sha1 conf -state readonly
+ grid $top.id $top.sha1 -sticky w
+ entry $top.head -width 60 -relief flat
+ $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
+ $top.head conf -state readonly
+ grid x $top.head -sticky w
+ label $top.tlab -text "Tag name:"
+ entry $top.tag -width 60
+ grid $top.tlab $top.tag -sticky w
+ frame $top.buts
+ button $top.buts.gen -text "Create" -command mktaggo
+ button $top.buts.can -text "Cancel" -command mktagcan
+ grid $top.buts.gen $top.buts.can
+ grid columnconfigure $top.buts 0 -weight 1 -uniform a
+ grid columnconfigure $top.buts 1 -weight 1 -uniform a
+ grid $top.buts - -pady 10 -sticky ew
+ focus $top.tag
+}
+
+proc domktag {} {
+ global mktagtop env tagids idtags
+
+ set id [$mktagtop.sha1 get]
+ set tag [$mktagtop.tag get]
+ if {$tag == {}} {
+ error_popup "No tag name specified"
+ return
+ }
+ if {[info exists tagids($tag)]} {
+ error_popup "Tag \"$tag\" already exists"
+ return
+ }
+ if {[catch {
+ set dir [gitdir]
+ set fname [file join $dir "refs/tags" $tag]
+ set f [open $fname w]
+ puts $f $id
+ close $f
+ } err]} {
+ error_popup "Error creating tag: $err"
+ return
+ }
+
+ set tagids($tag) $id
+ lappend idtags($id) $tag
+ redrawtags $id
+}
+
+proc redrawtags {id} {
+ global canv linehtag idline idpos selectedline
+
+ if {![info exists idline($id)]} return
+ $canv delete tag.$id
+ 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 0
+ }
+}
+
+proc mktagcan {} {
+ global mktagtop
+
+ catch {destroy $mktagtop}
+ unset mktagtop
+}
+
+proc mktaggo {} {
+ domktag
+ mktagcan
+}
+
+proc writecommit {} {
+ global rowmenuid wrcomtop commitinfo wrcomcmd
+
+ set top .writecommit
+ set wrcomtop $top
+ catch {destroy $top}
+ toplevel $top
+ label $top.title -text "Write commit to file"
+ grid $top.title - -pady 10
+ label $top.id -text "ID:"
+ entry $top.sha1 -width 40 -relief flat
+ $top.sha1 insert 0 $rowmenuid
+ $top.sha1 conf -state readonly
+ grid $top.id $top.sha1 -sticky w
+ entry $top.head -width 60 -relief flat
+ $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
+ $top.head conf -state readonly
+ grid x $top.head -sticky w
+ label $top.clab -text "Command:"
+ entry $top.cmd -width 60 -textvariable wrcomcmd
+ grid $top.clab $top.cmd -sticky w -pady 10
+ label $top.flab -text "Output file:"
+ entry $top.fname -width 60
+ $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
+ grid $top.flab $top.fname -sticky w
+ frame $top.buts
+ button $top.buts.gen -text "Write" -command wrcomgo
+ button $top.buts.can -text "Cancel" -command wrcomcan
+ grid $top.buts.gen $top.buts.can
+ grid columnconfigure $top.buts 0 -weight 1 -uniform a
+ grid columnconfigure $top.buts 1 -weight 1 -uniform a
+ grid $top.buts - -pady 10 -sticky ew
+ focus $top.fname
+}
+
+proc wrcomgo {} {
+ global wrcomtop
+
+ set id [$wrcomtop.sha1 get]
+ set cmd "echo $id | [$wrcomtop.cmd get]"
+ set fname [$wrcomtop.fname get]
+ if {[catch {exec sh -c $cmd >$fname &} err]} {
+ error_popup "Error writing commit: $err"
+ }
+ catch {destroy $wrcomtop}
+ unset wrcomtop
+}
+
+proc wrcomcan {} {
+ global wrcomtop
+
+ catch {destroy $wrcomtop}
+ unset wrcomtop
+}
+
+proc listrefs {id} {
+ global idtags idheads idotherrefs
+
+ set x {}
+ if {[info exists idtags($id)]} {
+ set x $idtags($id)
+ }
+ set y {}
+ if {[info exists idheads($id)]} {
+ set y $idheads($id)
+ }
+ set z {}
+ if {[info exists idotherrefs($id)]} {
+ set z $idotherrefs($id)
+ }
+ return [list $x $y $z]
+}
+
+proc rereadrefs {} {
+ global idtags idheads idotherrefs
+ global tagids headids otherrefids
+
+ set refids [concat [array names idtags] \
+ [array names idheads] [array names idotherrefs]]
+ foreach id $refids {
+ if {![info exists ref($id)]} {
+ set ref($id) [listrefs $id]
+ }
+ }
+ foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
+ catch {unset $v}
+ }
+ readrefs
+ set refids [lsort -unique [concat $refids [array names idtags] \
+ [array names idheads] [array names idotherrefs]]]
+ foreach id $refids {
+ set v [listrefs $id]
+ if {![info exists ref($id)] || $ref($id) != $v} {
+ redrawtags $id
+ }
+ }
+}
+
+proc showtag {tag isnew} {
+ global ctext cflist tagcontents tagids linknum
+
+ if {$isnew} {
+ addtohistory [list showtag $tag 0]
+ }
+ $ctext conf -state normal
+ $ctext delete 0.0 end
+ set linknum 0
+ if {[info exists tagcontents($tag)]} {
+ set text $tagcontents($tag)
+ } else {
+ set text "Tag: $tag\nId: $tagids($tag)"
+ }
+ appendwithlinks $text
+ $ctext conf -state disabled
+ $cflist delete 0 end
+}
+