gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "${1+$@}"
   4
   5 # Copyright (C) 2005 Paul Mackerras.  All rights reserved.
   6 # This program is free software; it may be used, copied, modified
   7 # and distributed under the terms of the GNU General Public Licence,
   8 # either version 2, or (at your option) any later version.
   9
  10 proc gitdir {} {
  11     global env
  12     if {[info exists env(GIT_DIR)]} {
  13         return $env(GIT_DIR)
  14     } else {
  15         return ".git"
  16     }
  17 }
  18
  19 proc getcommits {rargs} {
  20     global commits commfd phase canv mainfont env
  21     global startmsecs nextupdate ncmupdate
  22     global ctext maincursor textcursor leftover
  23
  24     # check that we can find a .git directory somewhere...
  25     set gitdir [gitdir]
  26     if {![file isdirectory $gitdir]} {
  27         error_popup "Cannot find the git directory \"$gitdir\"."
  28         exit 1
  29     }
  30     set commits {}
  31     set phase getcommits
  32     set startmsecs [clock clicks -milliseconds]
  33     set nextupdate [expr $startmsecs + 100]
  34     set ncmupdate 1
  35     if [catch {
  36         set parse_args [concat --default HEAD $rargs]
  37         set parsed_args [split [eval exec git-rev-parse $parse_args] "\n"]
  38     }] {
  39         # if git-rev-parse failed for some reason...
  40         if {$rargs == {}} {
  41             set rargs HEAD
  42         }
  43         set parsed_args $rargs
  44     }
  45     if [catch {
  46         set commfd [open "|git-rev-list --header --topo-order --parents $parsed_args" r]
  47     } err] {
  48         puts stderr "Error executing git-rev-list: $err"
  49         exit 1
  50     }
  51     set leftover {}
  52     fconfigure $commfd -blocking 0 -translation lf
  53     fileevent $commfd readable [list getcommitlines $commfd]
  54     $canv delete all
  55     $canv create text 3 3 -anchor nw -text "Reading commits..." \
  56         -font $mainfont -tags textitems
  57     . config -cursor watch
  58     settextcursor watch
  59 }
  60
  61 proc getcommitlines {commfd}  {
  62     global commits parents cdate children
  63     global commitlisted phase commitinfo nextupdate
  64     global stopped redisplaying leftover
  65
  66     set stuff [read $commfd]
  67     if {$stuff == {}} {
  68         if {![eof $commfd]} return
  69         # set it blocking so we wait for the process to terminate
  70         fconfigure $commfd -blocking 1
  71         if {![catch {close $commfd} err]} {
  72             after idle finishcommits
  73             return
  74         }
  75         if {[string range $err 0 4] == "usage"} {
  76             set err \
  77 {Gitk: error reading commits: bad arguments to git-rev-list.
  78 (Note: arguments to gitk are passed to git-rev-list
  79 to allow selection of commits to be displayed.)}
  80         } else {
  81             set err "Error reading commits: $err"
  82         }
  83         error_popup $err
  84         exit 1
  85     }
  86     set start 0
  87     while 1 {
  88         set i [string first "\0" $stuff $start]
  89         if {$i < 0} {
  90             append leftover [string range $stuff $start end]
  91             return
  92         }
  93         set cmit [string range $stuff $start [expr {$i - 1}]]
  94         if {$start == 0} {
  95             set cmit "$leftover$cmit"
  96             set leftover {}
  97         }
  98         set start [expr {$i + 1}]
  99         set j [string first "\n" $cmit]
 100         set ok 0
 101         if {$j >= 0} {
 102             set ids [string range $cmit 0 [expr {$j - 1}]]
 103             set ok 1
 104             foreach id $ids {
 105                 if {![regexp {^[0-9a-f]{40}$} $id]} {
 106                     set ok 0
 107                     break
 108                 }
 109             }
 110         }
 111         if {!$ok} {
 112             set shortcmit $cmit
 113             if {[string length $shortcmit] > 80} {
 114                 set shortcmit "[string range $shortcmit 0 80]..."
 115             }
 116             error_popup "Can't parse git-rev-list output: {$shortcmit}"
 117             exit 1
 118         }
 119         set id [lindex $ids 0]
 120         set olds [lrange $ids 1 end]
 121         set cmit [string range $cmit [expr {$j + 1}] end]
 122         lappend commits $id
 123         set commitlisted($id) 1
 124         parsecommit $id $cmit 1 [lrange $ids 1 end]
 125         drawcommit $id
 126         if {[clock clicks -milliseconds] >= $nextupdate} {
 127             doupdate 1
 128         }
 129         while {$redisplaying} {
 130             set redisplaying 0
 131             if {$stopped == 1} {
 132                 set stopped 0
 133                 set phase "getcommits"
 134                 foreach id $commits {
 135                     drawcommit $id
 136                     if {$stopped} break
 137                     if {[clock clicks -milliseconds] >= $nextupdate} {
 138                         doupdate 1
 139                     }
 140                 }
 141             }
 142         }
 143     }
 144 }
 145
 146 proc doupdate {reading} {
 147     global commfd nextupdate numcommits ncmupdate
 148
 149     if {$reading} {
 150         fileevent $commfd readable {}
 151     }
 152     update
 153     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
 154     if {$numcommits < 100} {
 155         set ncmupdate [expr {$numcommits + 1}]
 156     } elseif {$numcommits < 10000} {
 157         set ncmupdate [expr {$numcommits + 10}]
 158     } else {
 159         set ncmupdate [expr {$numcommits + 100}]
 160     }
 161     if {$reading} {
 162         fileevent $commfd readable [list getcommitlines $commfd]
 163     }
 164 }
 165
 166 proc readcommit {id} {
 167     if [catch {set contents [exec git-cat-file commit $id]}] return
 168     parsecommit $id $contents 0 {}
 169 }
 170
 171 proc parsecommit {id contents listed olds} {
 172     global commitinfo children nchildren parents nparents cdate ncleft
 173
 174     set inhdr 1
 175     set comment {}
 176     set headline {}
 177     set auname {}
 178     set audate {}
 179     set comname {}
 180     set comdate {}
 181     if {![info exists nchildren($id)]} {
 182         set children($id) {}
 183         set nchildren($id) 0
 184         set ncleft($id) 0
 185     }
 186     set parents($id) $olds
 187     set nparents($id) [llength $olds]
 188     foreach p $olds {
 189         if {![info exists nchildren($p)]} {
 190             set children($p) [list $id]
 191             set nchildren($p) 1
 192             set ncleft($p) 1
 193         } elseif {[lsearch -exact $children($p) $id] < 0} {
 194             lappend children($p) $id
 195             incr nchildren($p)
 196             incr ncleft($p)
 197         }
 198     }
 199     foreach line [split $contents "\n"] {
 200         if {$inhdr} {
 201             if {$line == {}} {
 202                 set inhdr 0
 203             } else {
 204                 set tag [lindex $line 0]
 205                 if {$tag == "author"} {
 206                     set x [expr {[llength $line] - 2}]
 207                     set audate [lindex $line $x]
 208                     set auname [lrange $line 1 [expr {$x - 1}]]
 209                 } elseif {$tag == "committer"} {
 210                     set x [expr {[llength $line] - 2}]
 211                     set comdate [lindex $line $x]
 212                     set comname [lrange $line 1 [expr {$x - 1}]]
 213                 }
 214             }
 215         } else {
 216             if {$comment == {}} {
 217                 set headline [string trim $line]
 218             } else {
 219                 append comment "\n"
 220             }
 221             if {!$listed} {
 222                 # git-rev-list indents the comment by 4 spaces;
 223                 # if we got this via git-cat-file, add the indentation
 224                 append comment "    "
 225             }
 226             append comment $line
 227         }
 228     }
 229     if {$audate != {}} {
 230         set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]
 231     }
 232     if {$comdate != {}} {
 233         set cdate($id) $comdate
 234         set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]
 235     }
 236     set commitinfo($id) [list $headline $auname $audate \
 237                              $comname $comdate $comment]
 238 }
 239
 240 proc readrefs {} {
 241     global tagids idtags headids idheads tagcontents
 242
 243     set tags [glob -nocomplain -types f [gitdir]/refs/tags/*]
 244     foreach f $tags {
 245         catch {
 246             set fd [open $f r]
 247             set line [read $fd]
 248             if {[regexp {^[0-9a-f]{40}} $line id]} {
 249                 set direct [file tail $f]
 250                 set tagids($direct) $id
 251                 lappend idtags($id) $direct
 252                 set tagblob [exec git-cat-file tag $id]
 253                 set contents [split $tagblob "\n"]
 254                 set obj {}
 255                 set type {}
 256                 set tag {}
 257                 foreach l $contents {
 258                     if {$l == {}} break
 259                     switch -- [lindex $l 0] {
 260                         "object" {set obj [lindex $l 1]}
 261                         "type" {set type [lindex $l 1]}
 262                         "tag" {set tag [string range $l 4 end]}
 263                     }
 264                 }
 265                 if {$obj != {} && $type == "commit" && $tag != {}} {
 266                     set tagids($tag) $obj
 267                     lappend idtags($obj) $tag
 268                     set tagcontents($tag) $tagblob
 269                 }
 270             }
 271             close $fd
 272         }
 273     }
 274     set heads [glob -nocomplain -types f [gitdir]/refs/heads/*]
 275     foreach f $heads {
 276         catch {
 277             set fd [open $f r]
 278             set line [read $fd 40]
 279             if {[regexp {^[0-9a-f]{40}} $line id]} {
 280                 set head [file tail $f]
 281                 set headids($head) $line
 282                 lappend idheads($line) $head
 283             }
 284             close $fd
 285         }
 286     }
 287     readotherrefs refs {} {tags heads}
 288 }
 289
 290 proc readotherrefs {base dname excl} {
 291     global otherrefids idotherrefs
 292
 293     set git [gitdir]
 294     set files [glob -nocomplain -types f [file join $git $base *]]
 295     foreach f $files {
 296         catch {
 297             set fd [open $f r]
 298             set line [read $fd 40]
 299             if {[regexp {^[0-9a-f]{40}} $line id]} {
 300                 set name "$dname[file tail $f]"
 301                 set otherrefids($name) $id
 302                 lappend idotherrefs($id) $name
 303             }
 304             close $fd
 305         }
 306     }
 307     set dirs [glob -nocomplain -types d [file join $git $base *]]
 308     foreach d $dirs {
 309         set dir [file tail $d]
 310         if {[lsearch -exact $excl $dir] >= 0} continue
 311         readotherrefs [file join $base $dir] "$dname$dir/" {}
 312     }
 313 }
 314
 315 proc error_popup msg {
 316     set w .error
 317     toplevel $w
 318     wm transient $w .
 319     message $w.m -text $msg -justify center -aspect 400
 320     pack $w.m -side top -fill x -padx 20 -pady 20
 321     button $w.ok -text OK -command "destroy $w"
 322     pack $w.ok -side bottom -fill x
 323     bind $w <Visibility> "grab $w; focus $w"
 324     tkwait window $w
 325 }
 326
 327 proc makewindow {} {
 328     global canv canv2 canv3 linespc charspc ctext cflist textfont
 329     global findtype findtypemenu findloc findstring fstring geometry
 330     global entries sha1entry sha1string sha1but
 331     global maincursor textcursor curtextcursor
 332     global rowctxmenu gaudydiff mergemax
 333
 334     menu .bar
 335     .bar add cascade -label "File" -menu .bar.file
 336     menu .bar.file
 337     .bar.file add command -label "Reread references" -command rereadrefs
 338     .bar.file add command -label "Quit" -command doquit
 339     menu .bar.help
 340     .bar add cascade -label "Help" -menu .bar.help
 341     .bar.help add command -label "About gitk" -command about
 342     . configure -menu .bar
 343
 344     if {![info exists geometry(canv1)]} {
 345         set geometry(canv1) [expr 45 * $charspc]
 346         set geometry(canv2) [expr 30 * $charspc]
 347         set geometry(canv3) [expr 15 * $charspc]
 348         set geometry(canvh) [expr 25 * $linespc + 4]
 349         set geometry(ctextw) 80
 350         set geometry(ctexth) 30
 351         set geometry(cflistw) 30
 352     }
 353     panedwindow .ctop -orient vertical
 354     if {[info exists geometry(width)]} {
 355         .ctop conf -width $geometry(width) -height $geometry(height)
 356         set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
 357         set geometry(ctexth) [expr {($texth - 8) /
 358                                     [font metrics $textfont -linespace]}]
 359     }
 360     frame .ctop.top
 361     frame .ctop.top.bar
 362     pack .ctop.top.bar -side bottom -fill x
 363     set cscroll .ctop.top.csb
 364     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 365     pack $cscroll -side right -fill y
 366     panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
 367     pack .ctop.top.clist -side top -fill both -expand 1
 368     .ctop add .ctop.top
 369     set canv .ctop.top.clist.canv
 370     canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
 371         -bg white -bd 0 \
 372         -yscrollincr $linespc -yscrollcommand "$cscroll set"
 373     .ctop.top.clist add $canv
 374     set canv2 .ctop.top.clist.canv2
 375     canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
 376         -bg white -bd 0 -yscrollincr $linespc
 377     .ctop.top.clist add $canv2
 378     set canv3 .ctop.top.clist.canv3
 379     canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
 380         -bg white -bd 0 -yscrollincr $linespc
 381     .ctop.top.clist add $canv3
 382     bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
 383
 384     set sha1entry .ctop.top.bar.sha1
 385     set entries $sha1entry
 386     set sha1but .ctop.top.bar.sha1label
 387     button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 388         -command gotocommit -width 8
 389     $sha1but conf -disabledforeground [$sha1but cget -foreground]
 390     pack .ctop.top.bar.sha1label -side left
 391     entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 392     trace add variable sha1string write sha1change
 393     pack $sha1entry -side left -pady 2
 394
 395     image create bitmap bm-left -data {
 396         #define left_width 16
 397         #define left_height 16
 398         static unsigned char left_bits[] = {
 399         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 400         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 401         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 402     }
 403     image create bitmap bm-right -data {
 404         #define right_width 16
 405         #define right_height 16
 406         static unsigned char right_bits[] = {
 407         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 408         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 409         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 410     }
 411     button .ctop.top.bar.leftbut -image bm-left -command goback \
 412         -state disabled -width 26
 413     pack .ctop.top.bar.leftbut -side left -fill y
 414     button .ctop.top.bar.rightbut -image bm-right -command goforw \
 415         -state disabled -width 26
 416     pack .ctop.top.bar.rightbut -side left -fill y
 417
 418     button .ctop.top.bar.findbut -text "Find" -command dofind
 419     pack .ctop.top.bar.findbut -side left
 420     set findstring {}
 421     set fstring .ctop.top.bar.findstring
 422     lappend entries $fstring
 423     entry $fstring -width 30 -font $textfont -textvariable findstring
 424     pack $fstring -side left -expand 1 -fill x
 425     set findtype Exact
 426     set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
 427                           findtype Exact IgnCase Regexp]
 428     set findloc "All fields"
 429     tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
 430         Comments Author Committer Files Pickaxe
 431     pack .ctop.top.bar.findloc -side right
 432     pack .ctop.top.bar.findtype -side right
 433     # for making sure type==Exact whenever loc==Pickaxe
 434     trace add variable findloc write findlocchange
 435
 436     panedwindow .ctop.cdet -orient horizontal
 437     .ctop add .ctop.cdet
 438     frame .ctop.cdet.left
 439     set ctext .ctop.cdet.left.ctext
 440     text $ctext -bg white -state disabled -font $textfont \
 441         -width $geometry(ctextw) -height $geometry(ctexth) \
 442         -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
 443     scrollbar .ctop.cdet.left.sb -command "$ctext yview"
 444     pack .ctop.cdet.left.sb -side right -fill y
 445     pack $ctext -side left -fill both -expand 1
 446     .ctop.cdet add .ctop.cdet.left
 447
 448     $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
 449     if {$gaudydiff} {
 450         $ctext tag conf hunksep -back blue -fore white
 451         $ctext tag conf d0 -back "#ff8080"
 452         $ctext tag conf d1 -back green
 453     } else {
 454         $ctext tag conf hunksep -fore blue
 455         $ctext tag conf d0 -fore red
 456         $ctext tag conf d1 -fore "#00a000"
 457         $ctext tag conf m0 -fore red
 458         $ctext tag conf m1 -fore blue
 459         $ctext tag conf m2 -fore green
 460         $ctext tag conf m3 -fore purple
 461         $ctext tag conf m4 -fore brown
 462         $ctext tag conf mmax -fore darkgrey
 463         set mergemax 5
 464         $ctext tag conf mresult -font [concat $textfont bold]
 465         $ctext tag conf msep -font [concat $textfont bold]
 466         $ctext tag conf found -back yellow
 467     }
 468
 469     frame .ctop.cdet.right
 470     set cflist .ctop.cdet.right.cfiles
 471     listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
 472         -yscrollcommand ".ctop.cdet.right.sb set"
 473     scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 474     pack .ctop.cdet.right.sb -side right -fill y
 475     pack $cflist -side left -fill both -expand 1
 476     .ctop.cdet add .ctop.cdet.right
 477     bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 478
 479     pack .ctop -side top -fill both -expand 1
 480
 481     bindall <1> {selcanvline %W %x %y}
 482     #bindall <B1-Motion> {selcanvline %W %x %y}
 483     bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 484     bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 485     bindall <2> "allcanvs scan mark 0 %y"
 486     bindall <B2-Motion> "allcanvs scan dragto 0 %y"
 487     bind . <Key-Up> "selnextline -1"
 488     bind . <Key-Down> "selnextline 1"
 489     bind . <Key-Prior> "allcanvs yview scroll -1 pages"
 490     bind . <Key-Next> "allcanvs yview scroll 1 pages"
 491     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 492     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 493     bindkey <Key-space> "$ctext yview scroll 1 pages"
 494     bindkey p "selnextline -1"
 495     bindkey n "selnextline 1"
 496     bindkey b "$ctext yview scroll -1 pages"
 497     bindkey d "$ctext yview scroll 18 units"
 498     bindkey u "$ctext yview scroll -18 units"
 499     bindkey / {findnext 1}
 500     bindkey <Key-Return> {findnext 0}
 501     bindkey ? findprev
 502     bindkey f nextfile
 503     bind . <Control-q> doquit
 504     bind . <Control-f> dofind
 505     bind . <Control-g> {findnext 0}
 506     bind . <Control-r> findprev
 507     bind . <Control-equal> {incrfont 1}
 508     bind . <Control-KP_Add> {incrfont 1}
 509     bind . <Control-minus> {incrfont -1}
 510     bind . <Control-KP_Subtract> {incrfont -1}
 511     bind $cflist <<ListboxSelect>> listboxsel
 512     bind . <Destroy> {savestuff %W}
 513     bind . <Button-1> "click %W"
 514     bind $fstring <Key-Return> dofind
 515     bind $sha1entry <Key-Return> gotocommit
 516     bind $sha1entry <<PasteSelection>> clearsha1
 517
 518     set maincursor [. cget -cursor]
 519     set textcursor [$ctext cget -cursor]
 520     set curtextcursor $textcursor
 521
 522     set rowctxmenu .rowctxmenu
 523     menu $rowctxmenu -tearoff 0
 524     $rowctxmenu add command -label "Diff this -> selected" \
 525         -command {diffvssel 0}
 526     $rowctxmenu add command -label "Diff selected -> this" \
 527         -command {diffvssel 1}
 528     $rowctxmenu add command -label "Make patch" -command mkpatch
 529     $rowctxmenu add command -label "Create tag" -command mktag
 530     $rowctxmenu add command -label "Write commit to file" -command writecommit
 531 }
 532
 533 # when we make a key binding for the toplevel, make sure
 534 # it doesn't get triggered when that key is pressed in the
 535 # find string entry widget.
 536 proc bindkey {ev script} {
 537     global entries
 538     bind . $ev $script
 539     set escript [bind Entry $ev]
 540     if {$escript == {}} {
 541         set escript [bind Entry <Key>]
 542     }
 543     foreach e $entries {
 544         bind $e $ev "$escript; break"
 545     }
 546 }
 547
 548 # set the focus back to the toplevel for any click outside
 549 # the entry widgets
 550 proc click {w} {
 551     global entries
 552     foreach e $entries {
 553         if {$w == $e} return
 554     }
 555     focus .
 556 }
 557
 558 proc savestuff {w} {
 559     global canv canv2 canv3 ctext cflist mainfont textfont
 560     global stuffsaved findmergefiles gaudydiff maxgraphpct
 561     global maxwidth
 562
 563     if {$stuffsaved} return
 564     if {![winfo viewable .]} return
 565     catch {
 566         set f [open "~/.gitk-new" w]
 567         puts $f [list set mainfont $mainfont]
 568         puts $f [list set textfont $textfont]
 569         puts $f [list set findmergefiles $findmergefiles]
 570         puts $f [list set gaudydiff $gaudydiff]
 571         puts $f [list set maxgraphpct $maxgraphpct]
 572         puts $f [list set maxwidth $maxwidth]
 573         puts $f "set geometry(width) [winfo width .ctop]"
 574         puts $f "set geometry(height) [winfo height .ctop]"
 575         puts $f "set geometry(canv1) [expr [winfo width $canv]-2]"
 576         puts $f "set geometry(canv2) [expr [winfo width $canv2]-2]"
 577         puts $f "set geometry(canv3) [expr [winfo width $canv3]-2]"
 578         puts $f "set geometry(canvh) [expr [winfo height $canv]-2]"
 579         set wid [expr {([winfo width $ctext] - 8) \
 580                            / [font measure $textfont "0"]}]
 581         puts $f "set geometry(ctextw) $wid"
 582         set wid [expr {([winfo width $cflist] - 11) \
 583                            / [font measure [$cflist cget -font] "0"]}]
 584         puts $f "set geometry(cflistw) $wid"
 585         close $f
 586         file rename -force "~/.gitk-new" "~/.gitk"
 587     }
 588     set stuffsaved 1
 589 }
 590
 591 proc resizeclistpanes {win w} {
 592     global oldwidth
 593     if [info exists oldwidth($win)] {
 594         set s0 [$win sash coord 0]
 595         set s1 [$win sash coord 1]
 596         if {$w < 60} {
 597             set sash0 [expr {int($w/2 - 2)}]
 598             set sash1 [expr {int($w*5/6 - 2)}]
 599         } else {
 600             set factor [expr {1.0 * $w / $oldwidth($win)}]
 601             set sash0 [expr {int($factor * [lindex $s0 0])}]
 602             set sash1 [expr {int($factor * [lindex $s1 0])}]
 603             if {$sash0 < 30} {
 604                 set sash0 30
 605             }
 606             if {$sash1 < $sash0 + 20} {
 607                 set sash1 [expr $sash0 + 20]
 608             }
 609             if {$sash1 > $w - 10} {
 610                 set sash1 [expr $w - 10]
 611                 if {$sash0 > $sash1 - 20} {
 612                     set sash0 [expr $sash1 - 20]
 613                 }
 614             }
 615         }
 616         $win sash place 0 $sash0 [lindex $s0 1]
 617         $win sash place 1 $sash1 [lindex $s1 1]
 618     }
 619     set oldwidth($win) $w
 620 }
 621
 622 proc resizecdetpanes {win w} {
 623     global oldwidth
 624     if [info exists oldwidth($win)] {
 625         set s0 [$win sash coord 0]
 626         if {$w < 60} {
 627             set sash0 [expr {int($w*3/4 - 2)}]
 628         } else {
 629             set factor [expr {1.0 * $w / $oldwidth($win)}]
 630             set sash0 [expr {int($factor * [lindex $s0 0])}]
 631             if {$sash0 < 45} {
 632                 set sash0 45
 633             }
 634             if {$sash0 > $w - 15} {
 635                 set sash0 [expr $w - 15]
 636             }
 637         }
 638         $win sash place 0 $sash0 [lindex $s0 1]
 639     }
 640     set oldwidth($win) $w
 641 }
 642
 643 proc allcanvs args {
 644     global canv canv2 canv3
 645     eval $canv $args
 646     eval $canv2 $args
 647     eval $canv3 $args
 648 }
 649
 650 proc bindall {event action} {
 651     global canv canv2 canv3
 652     bind $canv $event $action
 653     bind $canv2 $event $action
 654     bind $canv3 $event $action
 655 }
 656
 657 proc about {} {
 658     set w .about
 659     if {[winfo exists $w]} {
 660         raise $w
 661         return
 662     }
 663     toplevel $w
 664     wm title $w "About gitk"
 665     message $w.m -text {
 666 Gitk version 1.2
 667
 668 Copyright © 2005 Paul Mackerras
 669
 670 Use and redistribute under the terms of the GNU General Public License} \
 671             -justify center -aspect 400
 672     pack $w.m -side top -fill x -padx 20 -pady 20
 673     button $w.ok -text Close -command "destroy $w"
 674     pack $w.ok -side bottom
 675 }
 676
 677 proc assigncolor {id} {
 678     global commitinfo colormap commcolors colors nextcolor
 679     global parents nparents children nchildren
 680     global cornercrossings crossings
 681
 682     if [info exists colormap($id)] return
 683     set ncolors [llength $colors]
 684     if {$nparents($id) <= 1 && $nchildren($id) == 1} {
 685         set child [lindex $children($id) 0]
 686         if {[info exists colormap($child)]
 687             && $nparents($child) == 1} {
 688             set colormap($id) $colormap($child)
 689             return
 690         }
 691     }
 692     set badcolors {}
 693     if {[info exists cornercrossings($id)]} {
 694         foreach x $cornercrossings($id) {
 695             if {[info exists colormap($x)]
 696                 && [lsearch -exact $badcolors $colormap($x)] < 0} {
 697                 lappend badcolors $colormap($x)
 698             }
 699         }
 700         if {[llength $badcolors] >= $ncolors} {
 701             set badcolors {}
 702         }
 703     }
 704     set origbad $badcolors
 705     if {[llength $badcolors] < $ncolors - 1} {
 706         if {[info exists crossings($id)]} {
 707             foreach x $crossings($id) {
 708                 if {[info exists colormap($x)]
 709                     && [lsearch -exact $badcolors $colormap($x)] < 0} {
 710                     lappend badcolors $colormap($x)
 711                 }
 712             }
 713             if {[llength $badcolors] >= $ncolors} {
 714                 set badcolors $origbad
 715             }
 716         }
 717         set origbad $badcolors
 718     }
 719     if {[llength $badcolors] < $ncolors - 1} {
 720         foreach child $children($id) {
 721             if {[info exists colormap($child)]
 722                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
 723                 lappend badcolors $colormap($child)
 724             }
 725             if {[info exists parents($child)]} {
 726                 foreach p $parents($child) {
 727                     if {[info exists colormap($p)]
 728                         && [lsearch -exact $badcolors $colormap($p)] < 0} {
 729                         lappend badcolors $colormap($p)
 730                     }
 731                 }
 732             }
 733         }
 734         if {[llength $badcolors] >= $ncolors} {
 735             set badcolors $origbad
 736         }
 737     }
 738     for {set i 0} {$i <= $ncolors} {incr i} {
 739         set c [lindex $colors $nextcolor]
 740         if {[incr nextcolor] >= $ncolors} {
 741             set nextcolor 0
 742         }
 743         if {[lsearch -exact $badcolors $c]} break
 744     }
 745     set colormap($id) $c
 746 }
 747
 748 proc initgraph {} {
 749     global canvy canvy0 lineno numcommits nextcolor linespc
 750     global mainline mainlinearrow sidelines
 751     global nchildren ncleft
 752     global displist nhyperspace
 753
 754     allcanvs delete all
 755     set nextcolor 0
 756     set canvy $canvy0
 757     set lineno -1
 758     set numcommits 0
 759     catch {unset mainline}
 760     catch {unset mainlinearrow}
 761     catch {unset sidelines}
 762     foreach id [array names nchildren] {
 763         set ncleft($id) $nchildren($id)
 764     }
 765     set displist {}
 766     set nhyperspace 0
 767 }
 768
 769 proc bindline {t id} {
 770     global canv
 771
 772     $canv bind $t <Enter> "lineenter %x %y $id"
 773     $canv bind $t <Motion> "linemotion %x %y $id"
 774     $canv bind $t <Leave> "lineleave $id"
 775     $canv bind $t <Button-1> "lineclick %x %y $id 1"
 776 }
 777
 778 # level here is an index in displist
 779 proc drawcommitline {level} {
 780     global parents children nparents displist
 781     global canv canv2 canv3 mainfont namefont canvy linespc
 782     global lineid linehtag linentag linedtag commitinfo
 783     global colormap numcommits currentparents dupparents
 784     global idtags idline idheads idotherrefs
 785     global lineno lthickness mainline mainlinearrow sidelines
 786     global commitlisted rowtextx idpos lastuse displist
 787     global oldnlines olddlevel olddisplist
 788
 789     incr numcommits
 790     incr lineno
 791     set id [lindex $displist $level]
 792     set lastuse($id) $lineno
 793     set lineid($lineno) $id
 794     set idline($id) $lineno
 795     set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
 796     if {![info exists commitinfo($id)]} {
 797         readcommit $id
 798         if {![info exists commitinfo($id)]} {
 799             set commitinfo($id) {"No commit information available"}
 800             set nparents($id) 0
 801         }
 802     }
 803     assigncolor $id
 804     set currentparents {}
 805     set dupparents {}
 806     if {[info exists commitlisted($id)] && [info exists parents($id)]} {
 807         foreach p $parents($id) {
 808             if {[lsearch -exact $currentparents $p] < 0} {
 809                 lappend currentparents $p
 810             } else {
 811                 # remember that this parent was listed twice
 812                 lappend dupparents $p
 813             }
 814         }
 815     }
 816     set x [xcoord $level $level $lineno]
 817     set y1 $canvy
 818     set canvy [expr $canvy + $linespc]
 819     allcanvs conf -scrollregion \
 820         [list 0 0 0 [expr $y1 + 0.5 * $linespc + 2]]
 821     if {[info exists mainline($id)]} {
 822         lappend mainline($id) $x $y1
 823         if {$mainlinearrow($id) ne "none"} {
 824             set mainline($id) [trimdiagstart $mainline($id)]
 825         }
 826         set t [$canv create line $mainline($id) \
 827                    -width $lthickness -fill $colormap($id) \
 828                    -arrow $mainlinearrow($id)]
 829         $canv lower $t
 830         bindline $t $id
 831     }
 832     if {[info exists sidelines($id)]} {
 833         foreach ls $sidelines($id) {
 834             set coords [lindex $ls 0]
 835             set thick [lindex $ls 1]
 836             set arrow [lindex $ls 2]
 837             set t [$canv create line $coords -fill $colormap($id) \
 838                        -width [expr {$thick * $lthickness}] -arrow $arrow]
 839             $canv lower $t
 840             bindline $t $id
 841         }
 842     }
 843     set orad [expr {$linespc / 3}]
 844     set t [$canv create oval [expr $x - $orad] [expr $y1 - $orad] \
 845                [expr $x + $orad - 1] [expr $y1 + $orad - 1] \
 846                -fill $ofill -outline black -width 1]
 847     $canv raise $t
 848     $canv bind $t <1> {selcanvline {} %x %y}
 849     set xt [xcoord [llength $displist] $level $lineno]
 850     if {[llength $currentparents] > 2} {
 851         set xt [expr {$xt + ([llength $currentparents] - 2) * $linespc}]
 852     }
 853     set rowtextx($lineno) $xt
 854     set idpos($id) [list $x $xt $y1]
 855     if {[info exists idtags($id)] || [info exists idheads($id)]
 856         || [info exists idotherrefs($id)]} {
 857         set xt [drawtags $id $x $xt $y1]
 858     }
 859     set headline [lindex $commitinfo($id) 0]
 860     set name [lindex $commitinfo($id) 1]
 861     set date [lindex $commitinfo($id) 2]
 862     set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
 863                                -text $headline -font $mainfont ]
 864     $canv bind $linehtag($lineno) <Button-3> "rowmenu %X %Y $id"
 865     set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
 866                                -text $name -font $namefont]
 867     set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
 868                                -text $date -font $mainfont]
 869
 870     set olddlevel $level
 871     set olddisplist $displist
 872     set oldnlines [llength $displist]
 873 }
 874
 875 proc drawtags {id x xt y1} {
 876     global idtags idheads idotherrefs
 877     global linespc lthickness
 878     global canv mainfont idline rowtextx
 879
 880     set marks {}
 881     set ntags 0
 882     set nheads 0
 883     if {[info exists idtags($id)]} {
 884         set marks $idtags($id)
 885         set ntags [llength $marks]
 886     }
 887     if {[info exists idheads($id)]} {
 888         set marks [concat $marks $idheads($id)]
 889         set nheads [llength $idheads($id)]
 890     }
 891     if {[info exists idotherrefs($id)]} {
 892         set marks [concat $marks $idotherrefs($id)]
 893     }
 894     if {$marks eq {}} {
 895         return $xt
 896     }
 897
 898     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
 899     set yt [expr $y1 - 0.5 * $linespc]
 900     set yb [expr $yt + $linespc - 1]
 901     set xvals {}
 902     set wvals {}
 903     foreach tag $marks {
 904         set wid [font measure $mainfont $tag]
 905         lappend xvals $xt
 906         lappend wvals $wid
 907         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
 908     }
 909     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
 910                -width $lthickness -fill black -tags tag.$id]
 911     $canv lower $t
 912     foreach tag $marks x $xvals wid $wvals {
 913         set xl [expr $x + $delta]
 914         set xr [expr $x + $delta + $wid + $lthickness]
 915         if {[incr ntags -1] >= 0} {
 916             # draw a tag
 917             set t [$canv create polygon $x [expr $yt + $delta] $xl $yt \
 918                        $xr $yt $xr $yb $xl $yb $x [expr $yb - $delta] \
 919                        -width 1 -outline black -fill yellow -tags tag.$id]
 920             $canv bind $t <1> [list showtag $tag 1]
 921             set rowtextx($idline($id)) [expr {$xr + $linespc}]
 922         } else {
 923             # draw a head or other ref
 924             if {[incr nheads -1] >= 0} {
 925                 set col green
 926             } else {
 927                 set col "#ddddff"
 928             }
 929             set xl [expr $xl - $delta/2]
 930             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
 931                 -width 1 -outline black -fill $col -tags tag.$id
 932         }
 933         set t [$canv create text $xl $y1 -anchor w -text $tag \
 934                    -font $mainfont -tags tag.$id]
 935         if {$ntags >= 0} {
 936             $canv bind $t <1> [list showtag $tag 1]
 937         }
 938     }
 939     return $xt
 940 }
 941
 942 proc notecrossings {id lo hi corner} {
 943     global olddisplist crossings cornercrossings
 944
 945     for {set i $lo} {[incr i] < $hi} {} {
 946         set p [lindex $olddisplist $i]
 947         if {$p == {}} continue
 948         if {$i == $corner} {
 949             if {![info exists cornercrossings($id)]
 950                 || [lsearch -exact $cornercrossings($id) $p] < 0} {
 951                 lappend cornercrossings($id) $p
 952             }
 953             if {![info exists cornercrossings($p)]
 954                 || [lsearch -exact $cornercrossings($p) $id] < 0} {
 955                 lappend cornercrossings($p) $id
 956             }
 957         } else {
 958             if {![info exists crossings($id)]
 959                 || [lsearch -exact $crossings($id) $p] < 0} {
 960                 lappend crossings($id) $p
 961             }
 962             if {![info exists crossings($p)]
 963                 || [lsearch -exact $crossings($p) $id] < 0} {
 964                 lappend crossings($p) $id
 965             }
 966         }
 967     }
 968 }
 969
 970 proc xcoord {i level ln} {
 971     global canvx0 xspc1 xspc2
 972
 973     set x [expr {$canvx0 + $i * $xspc1($ln)}]
 974     if {$i > 0 && $i == $level} {
 975         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
 976     } elseif {$i > $level} {
 977         set x [expr {$x + $xspc2 - $xspc1($ln)}]
 978     }
 979     return $x
 980 }
 981
 982 # it seems Tk can't draw arrows on the end of diagonal line segments...
 983 proc trimdiagend {line} {
 984     while {[llength $line] > 4} {
 985         set x1 [lindex $line end-3]
 986         set y1 [lindex $line end-2]
 987         set x2 [lindex $line end-1]
 988         set y2 [lindex $line end]
 989         if {($x1 == $x2) != ($y1 == $y2)} break
 990         set line [lreplace $line end-1 end]
 991     }
 992     return $line
 993 }
 994
 995 proc trimdiagstart {line} {
 996     while {[llength $line] > 4} {
 997         set x1 [lindex $line 0]
 998         set y1 [lindex $line 1]
 999         set x2 [lindex $line 2]
1000         set y2 [lindex $line 3]
1001         if {($x1 == $x2) != ($y1 == $y2)} break
1002         set line [lreplace $line 0 1]
1003     }
1004     return $line
1005 }
1006
1007 proc drawslants {id needonscreen nohs} {
1008     global canv mainline mainlinearrow sidelines
1009     global canvx0 canvy xspc1 xspc2 lthickness
1010     global currentparents dupparents
1011     global lthickness linespc canvy colormap lineno geometry
1012     global maxgraphpct maxwidth
1013     global displist onscreen lastuse
1014     global parents commitlisted
1015     global oldnlines olddlevel olddisplist
1016     global nhyperspace numcommits nnewparents
1017
1018     if {$lineno < 0} {
1019         lappend displist $id
1020         set onscreen($id) 1
1021         return 0
1022     }
1023
1024     set y1 [expr {$canvy - $linespc}]
1025     set y2 $canvy
1026
1027     # work out what we need to get back on screen
1028     set reins {}
1029     if {$onscreen($id) < 0} {
1030         # next to do isn't displayed, better get it on screen...
1031         lappend reins [list $id 0]
1032     }
1033     # make sure all the previous commits's parents are on the screen
1034     foreach p $currentparents {
1035         if {$onscreen($p) < 0} {
1036             lappend reins [list $p 0]
1037         }
1038     }
1039     # bring back anything requested by caller
1040     if {$needonscreen ne {}} {
1041         lappend reins $needonscreen
1042     }
1043
1044     # try the shortcut
1045     if {$currentparents == $id && $onscreen($id) == 0 && $reins eq {}} {
1046         set dlevel $olddlevel
1047         set x [xcoord $dlevel $dlevel $lineno]
1048         set mainline($id) [list $x $y1]
1049         set mainlinearrow($id) none
1050         set lastuse($id) $lineno
1051         set displist [lreplace $displist $dlevel $dlevel $id]
1052         set onscreen($id) 1
1053         set xspc1([expr {$lineno + 1}]) $xspc1($lineno)
1054         return $dlevel
1055     }
1056
1057     # update displist
1058     set displist [lreplace $displist $olddlevel $olddlevel]
1059     set j $olddlevel
1060     foreach p $currentparents {
1061         set lastuse($p) $lineno
1062         if {$onscreen($p) == 0} {
1063             set displist [linsert $displist $j $p]
1064             set onscreen($p) 1
1065             incr j
1066         }
1067     }
1068     if {$onscreen($id) == 0} {
1069         lappend displist $id
1070         set onscreen($id) 1
1071     }
1072
1073     # remove the null entry if present
1074     set nullentry [lsearch -exact $displist {}]
1075     if {$nullentry >= 0} {
1076         set displist [lreplace $displist $nullentry $nullentry]
1077     }
1078
1079     # bring back the ones we need now (if we did it earlier
1080     # it would change displist and invalidate olddlevel)
1081     foreach pi $reins {
1082         # test again in case of duplicates in reins
1083         set p [lindex $pi 0]
1084         if {$onscreen($p) < 0} {
1085             set onscreen($p) 1
1086             set lastuse($p) $lineno
1087             set displist [linsert $displist [lindex $pi 1] $p]
1088             incr nhyperspace -1
1089         }
1090     }
1091
1092     set lastuse($id) $lineno
1093
1094     # see if we need to make any lines jump off into hyperspace
1095     set displ [llength $displist]
1096     if {$displ > $maxwidth} {
1097         set ages {}
1098         foreach x $displist {
1099             lappend ages [list $lastuse($x) $x]
1100         }
1101         set ages [lsort -integer -index 0 $ages]
1102         set k 0
1103         while {$displ > $maxwidth} {
1104             set use [lindex $ages $k 0]
1105             set victim [lindex $ages $k 1]
1106             if {$use >= $lineno - 5} break
1107             incr k
1108             if {[lsearch -exact $nohs $victim] >= 0} continue
1109             set i [lsearch -exact $displist $victim]
1110             set displist [lreplace $displist $i $i]
1111             set onscreen($victim) -1
1112             incr nhyperspace
1113             incr displ -1
1114             if {$i < $nullentry} {
1115                 incr nullentry -1
1116             }
1117             set x [lindex $mainline($victim) end-1]
1118             lappend mainline($victim) $x $y1
1119             set line [trimdiagend $mainline($victim)]
1120             set arrow "last"
1121             if {$mainlinearrow($victim) ne "none"} {
1122                 set line [trimdiagstart $line]
1123                 set arrow "both"
1124             }
1125             lappend sidelines($victim) [list $line 1 $arrow]
1126             unset mainline($victim)
1127         }
1128     }
1129
1130     set dlevel [lsearch -exact $displist $id]
1131
1132     # If we are reducing, put in a null entry
1133     if {$displ < $oldnlines} {
1134         # does the next line look like a merge?
1135         # i.e. does it have > 1 new parent?
1136         if {$nnewparents($id) > 1} {
1137             set i [expr {$dlevel + 1}]
1138         } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
1139             set i $olddlevel
1140             if {$nullentry >= 0 && $nullentry < $i} {
1141                 incr i -1
1142             }
1143         } elseif {$nullentry >= 0} {
1144             set i $nullentry
1145             while {$i < $displ
1146                    && [lindex $olddisplist $i] == [lindex $displist $i]} {
1147                 incr i
1148             }
1149         } else {
1150             set i $olddlevel
1151             if {$dlevel >= $i} {
1152                 incr i
1153             }
1154         }
1155         if {$i < $displ} {
1156             set displist [linsert $displist $i {}]
1157             incr displ
1158             if {$dlevel >= $i} {
1159                 incr dlevel
1160             }
1161         }
1162     }
1163
1164     # decide on the line spacing for the next line
1165     set lj [expr {$lineno + 1}]
1166     set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
1167     if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} {
1168         set xspc1($lj) $xspc2
1169     } else {
1170         set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}]
1171         if {$xspc1($lj) < $lthickness} {
1172             set xspc1($lj) $lthickness
1173         }
1174     }
1175
1176     foreach idi $reins {
1177         set id [lindex $idi 0]
1178         set j [lsearch -exact $displist $id]
1179         set xj [xcoord $j $dlevel $lj]
1180         set mainline($id) [list $xj $y2]
1181         set mainlinearrow($id) first
1182     }
1183
1184     set i -1
1185     foreach id $olddisplist {
1186         incr i
1187         if {$id == {}} continue
1188         if {$onscreen($id) <= 0} continue
1189         set xi [xcoord $i $olddlevel $lineno]
1190         if {$i == $olddlevel} {
1191             foreach p $currentparents {
1192                 set j [lsearch -exact $displist $p]
1193                 set coords [list $xi $y1]
1194                 set xj [xcoord $j $dlevel $lj]
1195                 if {$xj < $xi - $linespc} {
1196                     lappend coords [expr {$xj + $linespc}] $y1
1197                     notecrossings $p $j $i [expr {$j + 1}]
1198                 } elseif {$xj > $xi + $linespc} {
1199                     lappend coords [expr {$xj - $linespc}] $y1
1200                     notecrossings $p $i $j [expr {$j - 1}]
1201                 }
1202                 if {[lsearch -exact $dupparents $p] >= 0} {
1203                     # draw a double-width line to indicate the doubled parent
1204                     lappend coords $xj $y2
1205                     lappend sidelines($p) [list $coords 2 none]
1206                     if {![info exists mainline($p)]} {
1207                         set mainline($p) [list $xj $y2]
1208                         set mainlinearrow($p) none
1209                     }
1210                 } else {
1211                     # normal case, no parent duplicated
1212                     set yb $y2
1213                     set dx [expr {abs($xi - $xj)}]
1214                     if {0 && $dx < $linespc} {
1215                         set yb [expr {$y1 + $dx}]
1216                     }
1217                     if {![info exists mainline($p)]} {
1218                         if {$xi != $xj} {
1219                             lappend coords $xj $yb
1220                         }
1221                         set mainline($p) $coords
1222                         set mainlinearrow($p) none
1223                     } else {
1224                         lappend coords $xj $yb
1225                         if {$yb < $y2} {
1226                             lappend coords $xj $y2
1227                         }
1228                         lappend sidelines($p) [list $coords 1 none]
1229                     }
1230                 }
1231             }
1232         } else {
1233             set j $i
1234             if {[lindex $displist $i] != $id} {
1235                 set j [lsearch -exact $displist $id]
1236             }
1237             if {$j != $i || $xspc1($lineno) != $xspc1($lj)
1238                 || ($olddlevel < $i && $i < $dlevel)
1239                 || ($dlevel < $i && $i < $olddlevel)} {
1240                 set xj [xcoord $j $dlevel $lj]
1241                 lappend mainline($id) $xi $y1 $xj $y2
1242             }
1243         }
1244     }
1245     return $dlevel
1246 }
1247
1248 # search for x in a list of lists
1249 proc llsearch {llist x} {
1250     set i 0
1251     foreach l $llist {
1252         if {$l == $x || [lsearch -exact $l $x] >= 0} {
1253             return $i
1254         }
1255         incr i
1256     }
1257     return -1
1258 }
1259
1260 proc drawmore {reading} {
1261     global displayorder numcommits ncmupdate nextupdate
1262     global stopped nhyperspace parents commitlisted
1263     global maxwidth onscreen displist currentparents olddlevel
1264
1265     set n [llength $displayorder]
1266     while {$numcommits < $n} {
1267         set id [lindex $displayorder $numcommits]
1268         set ctxend [expr {$numcommits + 10}]
1269         if {!$reading && $ctxend > $n} {
1270             set ctxend $n
1271         }
1272         set dlist {}
1273         if {$numcommits > 0} {
1274             set dlist [lreplace $displist $olddlevel $olddlevel]
1275             set i $olddlevel
1276             foreach p $currentparents {
1277                 if {$onscreen($p) == 0} {
1278                     set dlist [linsert $dlist $i $p]
1279                     incr i
1280                 }
1281             }
1282         }
1283         set nohs {}
1284         set reins {}
1285         set isfat [expr {[llength $dlist] > $maxwidth}]
1286         if {$nhyperspace > 0 || $isfat} {
1287             if {$ctxend > $n} break
1288             # work out what to bring back and
1289             # what we want to don't want to send into hyperspace
1290             set room 1
1291             for {set k $numcommits} {$k < $ctxend} {incr k} {
1292                 set x [lindex $displayorder $k]
1293                 set i [llsearch $dlist $x]
1294                 if {$i < 0} {
1295                     set i [llength $dlist]
1296                     lappend dlist $x
1297                 }
1298                 if {[lsearch -exact $nohs $x] < 0} {
1299                     lappend nohs $x
1300                 }
1301                 if {$reins eq {} && $onscreen($x) < 0 && $room} {
1302                     set reins [list $x $i]
1303                 }
1304                 set newp {}
1305                 if {[info exists commitlisted($x)]} {
1306                     set right 0
1307                     foreach p $parents($x) {
1308                         if {[llsearch $dlist $p] < 0} {
1309                             lappend newp $p
1310                             if {[lsearch -exact $nohs $p] < 0} {
1311                                 lappend nohs $p
1312                             }
1313                             if {$reins eq {} && $onscreen($p) < 0 && $room} {
1314                                 set reins [list $p [expr {$i + $right}]]
1315                             }
1316                         }
1317                         set right 1
1318                     }
1319                 }
1320                 set l [lindex $dlist $i]
1321                 if {[llength $l] == 1} {
1322                     set l $newp
1323                 } else {
1324                     set j [lsearch -exact $l $x]
1325                     set l [concat [lreplace $l $j $j] $newp]
1326                 }
1327                 set dlist [lreplace $dlist $i $i $l]
1328                 if {$room && $isfat && [llength $newp] <= 1} {
1329                     set room 0
1330                 }
1331             }
1332         }
1333
1334         set dlevel [drawslants $id $reins $nohs]
1335         drawcommitline $dlevel
1336         if {[clock clicks -milliseconds] >= $nextupdate
1337             && $numcommits >= $ncmupdate} {
1338             doupdate $reading
1339             if {$stopped} break
1340         }
1341     }
1342 }
1343
1344 # level here is an index in todo
1345 proc updatetodo {level noshortcut} {
1346     global ncleft todo nnewparents
1347     global commitlisted parents onscreen
1348
1349     set id [lindex $todo $level]
1350     set olds {}
1351     if {[info exists commitlisted($id)]} {
1352         foreach p $parents($id) {
1353             if {[lsearch -exact $olds $p] < 0} {
1354                 lappend olds $p
1355             }
1356         }
1357     }
1358     if {!$noshortcut && [llength $olds] == 1} {
1359         set p [lindex $olds 0]
1360         if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
1361             set ncleft($p) 0
1362             set todo [lreplace $todo $level $level $p]
1363             set onscreen($p) 0
1364             set nnewparents($id) 1
1365             return 0
1366         }
1367     }
1368
1369     set todo [lreplace $todo $level $level]
1370     set i $level
1371     set n 0
1372     foreach p $olds {
1373         incr ncleft($p) -1
1374         set k [lsearch -exact $todo $p]
1375         if {$k < 0} {
1376             set todo [linsert $todo $i $p]
1377             set onscreen($p) 0
1378             incr i
1379             incr n
1380         }
1381     }
1382     set nnewparents($id) $n
1383
1384     return 1
1385 }
1386
1387 proc decidenext {{noread 0}} {
1388     global ncleft todo
1389     global datemode cdate
1390     global commitinfo
1391
1392     # choose which one to do next time around
1393     set todol [llength $todo]
1394     set level -1
1395     set latest {}
1396     for {set k $todol} {[incr k -1] >= 0} {} {
1397         set p [lindex $todo $k]
1398         if {$ncleft($p) == 0} {
1399             if {$datemode} {
1400                 if {![info exists commitinfo($p)]} {
1401                     if {$noread} {
1402                         return {}
1403                     }
1404                     readcommit $p
1405                 }
1406                 if {$latest == {} || $cdate($p) > $latest} {
1407                     set level $k
1408                     set latest $cdate($p)
1409                 }
1410             } else {
1411                 set level $k
1412                 break
1413             }
1414         }
1415     }
1416     if {$level < 0} {
1417         if {$todo != {}} {
1418             puts "ERROR: none of the pending commits can be done yet:"
1419             foreach p $todo {
1420                 puts "  $p ($ncleft($p))"
1421             }
1422         }
1423         return -1
1424     }
1425
1426     return $level
1427 }
1428
1429 proc drawcommit {id} {
1430     global phase todo nchildren datemode nextupdate
1431     global numcommits ncmupdate displayorder todo onscreen
1432
1433     if {$phase != "incrdraw"} {
1434         set phase incrdraw
1435         set displayorder {}
1436         set todo {}
1437         initgraph
1438     }
1439     if {$nchildren($id) == 0} {
1440         lappend todo $id
1441         set onscreen($id) 0
1442     }
1443     set level [decidenext 1]
1444     if {$level == {} || $id != [lindex $todo $level]} {
1445         return
1446     }
1447     while 1 {
1448         lappend displayorder [lindex $todo $level]
1449         if {[updatetodo $level $datemode]} {
1450             set level [decidenext 1]
1451             if {$level == {}} break
1452         }
1453         set id [lindex $todo $level]
1454         if {![info exists commitlisted($id)]} {
1455             break
1456         }
1457     }
1458     drawmore 1
1459 }
1460
1461 proc finishcommits {} {
1462     global phase
1463     global canv mainfont ctext maincursor textcursor
1464
1465     if {$phase != "incrdraw"} {
1466         $canv delete all
1467         $canv create text 3 3 -anchor nw -text "No commits selected" \
1468             -font $mainfont -tags textitems
1469         set phase {}
1470     } else {
1471         drawrest
1472     }
1473     . config -cursor $maincursor
1474     settextcursor $textcursor
1475 }
1476
1477 # Don't change the text pane cursor if it is currently the hand cursor,
1478 # showing that we are over a sha1 ID link.
1479 proc settextcursor {c} {
1480     global ctext curtextcursor
1481
1482     if {[$ctext cget -cursor] == $curtextcursor} {
1483         $ctext config -cursor $c
1484     }
1485     set curtextcursor $c
1486 }
1487
1488 proc drawgraph {} {
1489     global nextupdate startmsecs ncmupdate
1490     global displayorder onscreen
1491
1492     if {$displayorder == {}} return
1493     set startmsecs [clock clicks -milliseconds]
1494     set nextupdate [expr $startmsecs + 100]
1495     set ncmupdate 1
1496     initgraph
1497     foreach id $displayorder {
1498         set onscreen($id) 0
1499     }
1500     drawmore 0
1501 }
1502
1503 proc drawrest {} {
1504     global phase stopped redisplaying selectedline
1505     global datemode todo displayorder
1506     global numcommits ncmupdate
1507     global nextupdate startmsecs
1508
1509     set level [decidenext]
1510     if {$level >= 0} {
1511         set phase drawgraph
1512         while 1 {
1513             lappend displayorder [lindex $todo $level]
1514             set hard [updatetodo $level $datemode]
1515             if {$hard} {
1516                 set level [decidenext]
1517                 if {$level < 0} break
1518             }
1519         }
1520         drawmore 0
1521     }
1522     set phase {}
1523     set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
1524     #puts "overall $drawmsecs ms for $numcommits commits"
1525     if {$redisplaying} {
1526         if {$stopped == 0 && [info exists selectedline]} {
1527             selectline $selectedline 0
1528         }
1529         if {$stopped == 1} {
1530             set stopped 0
1531             after idle drawgraph
1532         } else {
1533             set redisplaying 0
1534         }
1535     }
1536 }
1537
1538 proc findmatches {f} {
1539     global findtype foundstring foundstrlen
1540     if {$findtype == "Regexp"} {
1541         set matches [regexp -indices -all -inline $foundstring $f]
1542     } else {
1543         if {$findtype == "IgnCase"} {
1544             set str [string tolower $f]
1545         } else {
1546             set str $f
1547         }
1548         set matches {}
1549         set i 0
1550         while {[set j [string first $foundstring $str $i]] >= 0} {
1551             lappend matches [list $j [expr $j+$foundstrlen-1]]
1552             set i [expr $j + $foundstrlen]
1553         }
1554     }
1555     return $matches
1556 }
1557
1558 proc dofind {} {
1559     global findtype findloc findstring markedmatches commitinfo
1560     global numcommits lineid linehtag linentag linedtag
1561     global mainfont namefont canv canv2 canv3 selectedline
1562     global matchinglines foundstring foundstrlen
1563
1564     stopfindproc
1565     unmarkmatches
1566     focus .
1567     set matchinglines {}
1568     if {$findloc == "Pickaxe"} {
1569         findpatches
1570         return
1571     }
1572     if {$findtype == "IgnCase"} {
1573         set foundstring [string tolower $findstring]
1574     } else {
1575         set foundstring $findstring
1576     }
1577     set foundstrlen [string length $findstring]
1578     if {$foundstrlen == 0} return
1579     if {$findloc == "Files"} {
1580         findfiles
1581         return
1582     }
1583     if {![info exists selectedline]} {
1584         set oldsel -1
1585     } else {
1586         set oldsel $selectedline
1587     }
1588     set didsel 0
1589     set fldtypes {Headline Author Date Committer CDate Comment}
1590     for {set l 0} {$l < $numcommits} {incr l} {
1591         set id $lineid($l)
1592         set info $commitinfo($id)
1593         set doesmatch 0
1594         foreach f $info ty $fldtypes {
1595             if {$findloc != "All fields" && $findloc != $ty} {
1596                 continue
1597             }
1598             set matches [findmatches $f]
1599             if {$matches == {}} continue
1600             set doesmatch 1
1601             if {$ty == "Headline"} {
1602                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1603             } elseif {$ty == "Author"} {
1604                 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1605             } elseif {$ty == "Date"} {
1606                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1607             }
1608         }
1609         if {$doesmatch} {
1610             lappend matchinglines $l
1611             if {!$didsel && $l > $oldsel} {
1612                 findselectline $l
1613                 set didsel 1
1614             }
1615         }
1616     }
1617     if {$matchinglines == {}} {
1618         bell
1619     } elseif {!$didsel} {
1620         findselectline [lindex $matchinglines 0]
1621     }
1622 }
1623
1624 proc findselectline {l} {
1625     global findloc commentend ctext
1626     selectline $l 1
1627     if {$findloc == "All fields" || $findloc == "Comments"} {
1628         # highlight the matches in the comments
1629         set f [$ctext get 1.0 $commentend]
1630         set matches [findmatches $f]
1631         foreach match $matches {
1632             set start [lindex $match 0]
1633             set end [expr [lindex $match 1] + 1]
1634             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1635         }
1636     }
1637 }
1638
1639 proc findnext {restart} {
1640     global matchinglines selectedline
1641     if {![info exists matchinglines]} {
1642         if {$restart} {
1643             dofind
1644         }
1645         return
1646     }
1647     if {![info exists selectedline]} return
1648     foreach l $matchinglines {
1649         if {$l > $selectedline} {
1650             findselectline $l
1651             return
1652         }
1653     }
1654     bell
1655 }
1656
1657 proc findprev {} {
1658     global matchinglines selectedline
1659     if {![info exists matchinglines]} {
1660         dofind
1661         return
1662     }
1663     if {![info exists selectedline]} return
1664     set prev {}
1665     foreach l $matchinglines {
1666         if {$l >= $selectedline} break
1667         set prev $l
1668     }
1669     if {$prev != {}} {
1670         findselectline $prev
1671     } else {
1672         bell
1673     }
1674 }
1675
1676 proc findlocchange {name ix op} {
1677     global findloc findtype findtypemenu
1678     if {$findloc == "Pickaxe"} {
1679         set findtype Exact
1680         set state disabled
1681     } else {
1682         set state normal
1683     }
1684     $findtypemenu entryconf 1 -state $state
1685     $findtypemenu entryconf 2 -state $state
1686 }
1687
1688 proc stopfindproc {{done 0}} {
1689     global findprocpid findprocfile findids
1690     global ctext findoldcursor phase maincursor textcursor
1691     global findinprogress
1692
1693     catch {unset findids}
1694     if {[info exists findprocpid]} {
1695         if {!$done} {
1696             catch {exec kill $findprocpid}
1697         }
1698         catch {close $findprocfile}
1699         unset findprocpid
1700     }
1701     if {[info exists findinprogress]} {
1702         unset findinprogress
1703         if {$phase != "incrdraw"} {
1704             . config -cursor $maincursor
1705             settextcursor $textcursor
1706         }
1707     }
1708 }
1709
1710 proc findpatches {} {
1711     global findstring selectedline numcommits
1712     global findprocpid findprocfile
1713     global finddidsel ctext lineid findinprogress
1714     global findinsertpos
1715
1716     if {$numcommits == 0} return
1717
1718     # make a list of all the ids to search, starting at the one
1719     # after the selected line (if any)
1720     if {[info exists selectedline]} {
1721         set l $selectedline
1722     } else {
1723         set l -1
1724     }
1725     set inputids {}
1726     for {set i 0} {$i < $numcommits} {incr i} {
1727         if {[incr l] >= $numcommits} {
1728             set l 0
1729         }
1730         append inputids $lineid($l) "\n"
1731     }
1732
1733     if {[catch {
1734         set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1735                          << $inputids] r]
1736     } err]} {
1737         error_popup "Error starting search process: $err"
1738         return
1739     }
1740
1741     set findinsertpos end
1742     set findprocfile $f
1743     set findprocpid [pid $f]
1744     fconfigure $f -blocking 0
1745     fileevent $f readable readfindproc
1746     set finddidsel 0
1747     . config -cursor watch
1748     settextcursor watch
1749     set findinprogress 1
1750 }
1751
1752 proc readfindproc {} {
1753     global findprocfile finddidsel
1754     global idline matchinglines findinsertpos
1755
1756     set n [gets $findprocfile line]
1757     if {$n < 0} {
1758         if {[eof $findprocfile]} {
1759             stopfindproc 1
1760             if {!$finddidsel} {
1761                 bell
1762             }
1763         }
1764         return
1765     }
1766     if {![regexp {^[0-9a-f]{40}} $line id]} {
1767         error_popup "Can't parse git-diff-tree output: $line"
1768         stopfindproc
1769         return
1770     }
1771     if {![info exists idline($id)]} {
1772         puts stderr "spurious id: $id"
1773         return
1774     }
1775     set l $idline($id)
1776     insertmatch $l $id
1777 }
1778
1779 proc insertmatch {l id} {
1780     global matchinglines findinsertpos finddidsel
1781
1782     if {$findinsertpos == "end"} {
1783         if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1784             set matchinglines [linsert $matchinglines 0 $l]
1785             set findinsertpos 1
1786         } else {
1787             lappend matchinglines $l
1788         }
1789     } else {
1790         set matchinglines [linsert $matchinglines $findinsertpos $l]
1791         incr findinsertpos
1792     }
1793     markheadline $l $id
1794     if {!$finddidsel} {
1795         findselectline $l
1796         set finddidsel 1
1797     }
1798 }
1799
1800 proc findfiles {} {
1801     global selectedline numcommits lineid ctext
1802     global ffileline finddidsel parents nparents
1803     global findinprogress findstartline findinsertpos
1804     global treediffs fdiffids fdiffsneeded fdiffpos
1805     global findmergefiles
1806
1807     if {$numcommits == 0} return
1808
1809     if {[info exists selectedline]} {
1810         set l [expr {$selectedline + 1}]
1811     } else {
1812         set l 0
1813     }
1814     set ffileline $l
1815     set findstartline $l
1816     set diffsneeded {}
1817     set fdiffsneeded {}
1818     while 1 {
1819         set id $lineid($l)
1820         if {$findmergefiles || $nparents($id) == 1} {
1821             foreach p $parents($id) {
1822                 if {![info exists treediffs([list $id $p])]} {
1823                     append diffsneeded "$id $p\n"
1824                     lappend fdiffsneeded [list $id $p]
1825                 }
1826             }
1827         }
1828         if {[incr l] >= $numcommits} {
1829             set l 0
1830         }
1831         if {$l == $findstartline} break
1832     }
1833
1834     # start off a git-diff-tree process if needed
1835     if {$diffsneeded ne {}} {
1836         if {[catch {
1837             set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1838         } err ]} {
1839             error_popup "Error starting search process: $err"
1840             return
1841         }
1842         catch {unset fdiffids}
1843         set fdiffpos 0
1844         fconfigure $df -blocking 0
1845         fileevent $df readable [list readfilediffs $df]
1846     }
1847
1848     set finddidsel 0
1849     set findinsertpos end
1850     set id $lineid($l)
1851     set p [lindex $parents($id) 0]
1852     . config -cursor watch
1853     settextcursor watch
1854     set findinprogress 1
1855     findcont [list $id $p]
1856     update
1857 }
1858
1859 proc readfilediffs {df} {
1860     global findids fdiffids fdiffs
1861
1862     set n [gets $df line]
1863     if {$n < 0} {
1864         if {[eof $df]} {
1865             donefilediff
1866             if {[catch {close $df} err]} {
1867                 stopfindproc
1868                 bell
1869                 error_popup "Error in git-diff-tree: $err"
1870             } elseif {[info exists findids]} {
1871                 set ids $findids
1872                 stopfindproc
1873                 bell
1874                 error_popup "Couldn't find diffs for {$ids}"
1875             }
1876         }
1877         return
1878     }
1879     if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} {
1880         # start of a new string of diffs
1881         donefilediff
1882         set fdiffids [list $id $p]
1883         set fdiffs {}
1884     } elseif {[string match ":*" $line]} {
1885         lappend fdiffs [lindex $line 5]
1886     }
1887 }
1888
1889 proc donefilediff {} {
1890     global fdiffids fdiffs treediffs findids
1891     global fdiffsneeded fdiffpos
1892
1893     if {[info exists fdiffids]} {
1894         while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
1895                && $fdiffpos < [llength $fdiffsneeded]} {
1896             # git-diff-tree doesn't output anything for a commit
1897             # which doesn't change anything
1898             set nullids [lindex $fdiffsneeded $fdiffpos]
1899             set treediffs($nullids) {}
1900             if {[info exists findids] && $nullids eq $findids} {
1901                 unset findids
1902                 findcont $nullids
1903             }
1904             incr fdiffpos
1905         }
1906         incr fdiffpos
1907
1908         if {![info exists treediffs($fdiffids)]} {
1909             set treediffs($fdiffids) $fdiffs
1910         }
1911         if {[info exists findids] && $fdiffids eq $findids} {
1912             unset findids
1913             findcont $fdiffids
1914         }
1915     }
1916 }
1917
1918 proc findcont {ids} {
1919     global findids treediffs parents nparents
1920     global ffileline findstartline finddidsel
1921     global lineid numcommits matchinglines findinprogress
1922     global findmergefiles
1923
1924     set id [lindex $ids 0]
1925     set p [lindex $ids 1]
1926     set pi [lsearch -exact $parents($id) $p]
1927     set l $ffileline
1928     while 1 {
1929         if {$findmergefiles || $nparents($id) == 1} {
1930             if {![info exists treediffs($ids)]} {
1931                 set findids $ids
1932                 set ffileline $l
1933                 return
1934             }
1935             set doesmatch 0
1936             foreach f $treediffs($ids) {
1937                 set x [findmatches $f]
1938                 if {$x != {}} {
1939                     set doesmatch 1
1940                     break
1941                 }
1942             }
1943             if {$doesmatch} {
1944                 insertmatch $l $id
1945                 set pi $nparents($id)
1946             }
1947         } else {
1948             set pi $nparents($id)
1949         }
1950         if {[incr pi] >= $nparents($id)} {
1951             set pi 0
1952             if {[incr l] >= $numcommits} {
1953                 set l 0
1954             }
1955             if {$l == $findstartline} break
1956             set id $lineid($l)
1957         }
1958         set p [lindex $parents($id) $pi]
1959         set ids [list $id $p]
1960     }
1961     stopfindproc
1962     if {!$finddidsel} {
1963         bell
1964     }
1965 }
1966
1967 # mark a commit as matching by putting a yellow background
1968 # behind the headline
1969 proc markheadline {l id} {
1970     global canv mainfont linehtag commitinfo
1971
1972     set bbox [$canv bbox $linehtag($l)]
1973     set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
1974     $canv lower $t
1975 }
1976
1977 # mark the bits of a headline, author or date that match a find string
1978 proc markmatches {canv l str tag matches font} {
1979     set bbox [$canv bbox $tag]
1980     set x0 [lindex $bbox 0]
1981     set y0 [lindex $bbox 1]
1982     set y1 [lindex $bbox 3]
1983     foreach match $matches {
1984         set start [lindex $match 0]
1985         set end [lindex $match 1]
1986         if {$start > $end} continue
1987         set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1988         set xlen [font measure $font [string range $str 0 [expr $end]]]
1989         set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1990                    -outline {} -tags matches -fill yellow]
1991         $canv lower $t
1992     }
1993 }
1994
1995 proc unmarkmatches {} {
1996     global matchinglines findids
1997     allcanvs delete matches
1998     catch {unset matchinglines}
1999     catch {unset findids}
2000 }
2001
2002 proc selcanvline {w x y} {
2003     global canv canvy0 ctext linespc
2004     global lineid linehtag linentag linedtag rowtextx
2005     set ymax [lindex [$canv cget -scrollregion] 3]
2006     if {$ymax == {}} return
2007     set yfrac [lindex [$canv yview] 0]
2008     set y [expr {$y + $yfrac * $ymax}]
2009     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2010     if {$l < 0} {
2011         set l 0
2012     }
2013     if {$w eq $canv} {
2014         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2015     }
2016     unmarkmatches
2017     selectline $l 1
2018 }
2019
2020 proc commit_descriptor {p} {
2021     global commitinfo
2022     set l "..."
2023     if {[info exists commitinfo($p)]} {
2024         set l [lindex $commitinfo($p) 0]
2025     }
2026     return "$p ($l)"
2027 }
2028
2029 # append some text to the ctext widget, and make any SHA1 ID
2030 # that we know about be a clickable link.
2031 proc appendwithlinks {text} {
2032     global ctext idline linknum
2033
2034     set start [$ctext index "end - 1c"]
2035     $ctext insert end $text
2036     $ctext insert end "\n"
2037     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2038     foreach l $links {
2039         set s [lindex $l 0]
2040         set e [lindex $l 1]
2041         set linkid [string range $text $s $e]
2042         if {![info exists idline($linkid)]} continue
2043         incr e
2044         $ctext tag add link "$start + $s c" "$start + $e c"
2045         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2046         $ctext tag bind link$linknum <1> [list selectline $idline($linkid) 1]
2047         incr linknum
2048     }
2049     $ctext tag conf link -foreground blue -underline 1
2050     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2051     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2052 }
2053
2054 proc selectline {l isnew} {
2055     global canv canv2 canv3 ctext commitinfo selectedline
2056     global lineid linehtag linentag linedtag
2057     global canvy0 linespc parents nparents children
2058     global cflist currentid sha1entry
2059     global commentend idtags idline linknum
2060
2061     $canv delete hover
2062     if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
2063     $canv delete secsel
2064     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2065                -tags secsel -fill [$canv cget -selectbackground]]
2066     $canv lower $t
2067     $canv2 delete secsel
2068     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2069                -tags secsel -fill [$canv2 cget -selectbackground]]
2070     $canv2 lower $t
2071     $canv3 delete secsel
2072     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2073                -tags secsel -fill [$canv3 cget -selectbackground]]
2074     $canv3 lower $t
2075     set y [expr {$canvy0 + $l * $linespc}]
2076     set ymax [lindex [$canv cget -scrollregion] 3]
2077     set ytop [expr {$y - $linespc - 1}]
2078     set ybot [expr {$y + $linespc + 1}]
2079     set wnow [$canv yview]
2080     set wtop [expr [lindex $wnow 0] * $ymax]
2081     set wbot [expr [lindex $wnow 1] * $ymax]
2082     set wh [expr {$wbot - $wtop}]
2083     set newtop $wtop
2084     if {$ytop < $wtop} {
2085         if {$ybot < $wtop} {
2086             set newtop [expr {$y - $wh / 2.0}]
2087         } else {
2088             set newtop $ytop
2089             if {$newtop > $wtop - $linespc} {
2090                 set newtop [expr {$wtop - $linespc}]
2091             }
2092         }
2093     } elseif {$ybot > $wbot} {
2094         if {$ytop > $wbot} {
2095             set newtop [expr {$y - $wh / 2.0}]
2096         } else {
2097             set newtop [expr {$ybot - $wh}]
2098             if {$newtop < $wtop + $linespc} {
2099                 set newtop [expr {$wtop + $linespc}]
2100             }
2101         }
2102     }
2103     if {$newtop != $wtop} {
2104         if {$newtop < 0} {
2105             set newtop 0
2106         }
2107         allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
2108     }
2109
2110     if {$isnew} {
2111         addtohistory [list selectline $l 0]
2112     }
2113
2114     set selectedline $l
2115
2116     set id $lineid($l)
2117     set currentid $id
2118     $sha1entry delete 0 end
2119     $sha1entry insert 0 $id
2120     $sha1entry selection from 0
2121     $sha1entry selection to end
2122
2123     $ctext conf -state normal
2124     $ctext delete 0.0 end
2125     set linknum 0
2126     $ctext mark set fmark.0 0.0
2127     $ctext mark gravity fmark.0 left
2128     set info $commitinfo($id)
2129     $ctext insert end "Author: [lindex $info 1]  [lindex $info 2]\n"
2130     $ctext insert end "Committer: [lindex $info 3]  [lindex $info 4]\n"
2131     if {[info exists idtags($id)]} {
2132         $ctext insert end "Tags:"
2133         foreach tag $idtags($id) {
2134             $ctext insert end " $tag"
2135         }
2136         $ctext insert end "\n"
2137     }
2138
2139     set comment {}
2140     if {[info exists parents($id)]} {
2141         foreach p $parents($id) {
2142             append comment "Parent: [commit_descriptor $p]\n"
2143         }
2144     }
2145     if {[info exists children($id)]} {
2146         foreach c $children($id) {
2147             append comment "Child:  [commit_descriptor $c]\n"
2148         }
2149     }
2150     append comment "\n"
2151     append comment [lindex $info 5]
2152
2153     # make anything that looks like a SHA1 ID be a clickable link
2154     appendwithlinks $comment
2155
2156     $ctext tag delete Comments
2157     $ctext tag remove found 1.0 end
2158     $ctext conf -state disabled
2159     set commentend [$ctext index "end - 1c"]
2160
2161     $cflist delete 0 end
2162     $cflist insert end "Comments"
2163     if {$nparents($id) == 1} {
2164         startdiff [concat $id $parents($id)]
2165     } elseif {$nparents($id) > 1} {
2166         mergediff $id
2167     }
2168 }
2169
2170 proc selnextline {dir} {
2171     global selectedline
2172     if {![info exists selectedline]} return
2173     set l [expr $selectedline + $dir]
2174     unmarkmatches
2175     selectline $l 1
2176 }
2177
2178 proc unselectline {} {
2179     global selectedline
2180
2181     catch {unset selectedline}
2182     allcanvs delete secsel
2183 }
2184
2185 proc addtohistory {cmd} {
2186     global history historyindex
2187
2188     if {$historyindex > 0
2189         && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2190         return
2191     }
2192
2193     if {$historyindex < [llength $history]} {
2194         set history [lreplace $history $historyindex end $cmd]
2195     } else {
2196         lappend history $cmd
2197     }
2198     incr historyindex
2199     if {$historyindex > 1} {
2200         .ctop.top.bar.leftbut conf -state normal
2201     } else {
2202         .ctop.top.bar.leftbut conf -state disabled
2203     }
2204     .ctop.top.bar.rightbut conf -state disabled
2205 }
2206
2207 proc goback {} {
2208     global history historyindex
2209
2210     if {$historyindex > 1} {
2211         incr historyindex -1
2212         set cmd [lindex $history [expr {$historyindex - 1}]]
2213         eval $cmd
2214         .ctop.top.bar.rightbut conf -state normal
2215     }
2216     if {$historyindex <= 1} {
2217         .ctop.top.bar.leftbut conf -state disabled
2218     }
2219 }
2220
2221 proc goforw {} {
2222     global history historyindex
2223
2224     if {$historyindex < [llength $history]} {
2225         set cmd [lindex $history $historyindex]
2226         incr historyindex
2227         eval $cmd
2228         .ctop.top.bar.leftbut conf -state normal
2229     }
2230     if {$historyindex >= [llength $history]} {
2231         .ctop.top.bar.rightbut conf -state disabled
2232     }
2233 }
2234
2235 proc mergediff {id} {
2236     global parents diffmergeid diffmergegca mergefilelist diffpindex
2237
2238     set diffmergeid $id
2239     set diffpindex -1
2240     set diffmergegca [findgca $parents($id)]
2241     if {[info exists mergefilelist($id)]} {
2242         if {$mergefilelist($id) ne {}} {
2243             showmergediff
2244         }
2245     } else {
2246         contmergediff {}
2247     }
2248 }
2249
2250 proc findgca {ids} {
2251     set gca {}
2252     foreach id $ids {
2253         if {$gca eq {}} {
2254             set gca $id
2255         } else {
2256             if {[catch {
2257                 set gca [exec git-merge-base $gca $id]
2258             } err]} {
2259                 return {}
2260             }
2261         }
2262     }
2263     return $gca
2264 }
2265
2266 proc contmergediff {ids} {
2267     global diffmergeid diffpindex parents nparents diffmergegca
2268     global treediffs mergefilelist diffids treepending
2269
2270     # diff the child against each of the parents, and diff
2271     # each of the parents against the GCA.
2272     while 1 {
2273         if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} {
2274             set ids [list [lindex $ids 1] $diffmergegca]
2275         } else {
2276             if {[incr diffpindex] >= $nparents($diffmergeid)} break
2277             set p [lindex $parents($diffmergeid) $diffpindex]
2278             set ids [list $diffmergeid $p]
2279         }
2280         if {![info exists treediffs($ids)]} {
2281             set diffids $ids
2282             if {![info exists treepending]} {
2283                 gettreediffs $ids
2284             }
2285             return
2286         }
2287     }
2288
2289     # If a file in some parent is different from the child and also
2290     # different from the GCA, then it's interesting.
2291     # If we don't have a GCA, then a file is interesting if it is
2292     # different from the child in all the parents.
2293     if {$diffmergegca ne {}} {
2294         set files {}
2295         foreach p $parents($diffmergeid) {
2296             set gcadiffs $treediffs([list $p $diffmergegca])
2297             foreach f $treediffs([list $diffmergeid $p]) {
2298                 if {[lsearch -exact $files $f] < 0
2299                     && [lsearch -exact $gcadiffs $f] >= 0} {
2300                     lappend files $f
2301                 }
2302             }
2303         }
2304         set files [lsort $files]
2305     } else {
2306         set p [lindex $parents($diffmergeid) 0]
2307         set files $treediffs([list $diffmergeid $p])
2308         for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
2309             set p [lindex $parents($diffmergeid) $i]
2310             set df $treediffs([list $diffmergeid $p])
2311             set nf {}
2312             foreach f $files {
2313                 if {[lsearch -exact $df $f] >= 0} {
2314                     lappend nf $f
2315                 }
2316             }
2317             set files $nf
2318         }
2319     }
2320
2321     set mergefilelist($diffmergeid) $files
2322     if {$files ne {}} {
2323         showmergediff
2324     }
2325 }
2326
2327 proc showmergediff {} {
2328     global cflist diffmergeid mergefilelist parents
2329     global diffopts diffinhunk currentfile currenthunk filelines
2330     global diffblocked groupfilelast mergefds groupfilenum grouphunks
2331
2332     set files $mergefilelist($diffmergeid)
2333     foreach f $files {
2334         $cflist insert end $f
2335     }
2336     set env(GIT_DIFF_OPTS) $diffopts
2337     set flist {}
2338     catch {unset currentfile}
2339     catch {unset currenthunk}
2340     catch {unset filelines}
2341     catch {unset groupfilenum}
2342     catch {unset grouphunks}
2343     set groupfilelast -1
2344     foreach p $parents($diffmergeid) {
2345         set cmd [list | git-diff-tree -p $p $diffmergeid]
2346         set cmd [concat $cmd $mergefilelist($diffmergeid)]
2347         if {[catch {set f [open $cmd r]} err]} {
2348             error_popup "Error getting diffs: $err"
2349             foreach f $flist {
2350                 catch {close $f}
2351             }
2352             return
2353         }
2354         lappend flist $f
2355         set ids [list $diffmergeid $p]
2356         set mergefds($ids) $f
2357         set diffinhunk($ids) 0
2358         set diffblocked($ids) 0
2359         fconfigure $f -blocking 0
2360         fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
2361     }
2362 }
2363
2364 proc getmergediffline {f ids id} {
2365     global diffmergeid diffinhunk diffoldlines diffnewlines
2366     global currentfile currenthunk
2367     global diffoldstart diffnewstart diffoldlno diffnewlno
2368     global diffblocked mergefilelist
2369     global noldlines nnewlines difflcounts filelines
2370
2371     set n [gets $f line]
2372     if {$n < 0} {
2373         if {![eof $f]} return
2374     }
2375
2376     if {!([info exists diffmergeid] && $diffmergeid == $id)} {
2377         if {$n < 0} {
2378             close $f
2379         }
2380         return
2381     }
2382
2383     if {$diffinhunk($ids) != 0} {
2384         set fi $currentfile($ids)
2385         if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
2386             # continuing an existing hunk
2387             set line [string range $line 1 end]
2388             set p [lindex $ids 1]
2389             if {$match eq "-" || $match eq " "} {
2390                 set filelines($p,$fi,$diffoldlno($ids)) $line
2391                 incr diffoldlno($ids)
2392             }
2393             if {$match eq "+" || $match eq " "} {
2394                 set filelines($id,$fi,$diffnewlno($ids)) $line
2395                 incr diffnewlno($ids)
2396             }
2397             if {$match eq " "} {
2398                 if {$diffinhunk($ids) == 2} {
2399                     lappend difflcounts($ids) \
2400                         [list $noldlines($ids) $nnewlines($ids)]
2401                     set noldlines($ids) 0
2402                     set diffinhunk($ids) 1
2403                 }
2404                 incr noldlines($ids)
2405             } elseif {$match eq "-" || $match eq "+"} {
2406                 if {$diffinhunk($ids) == 1} {
2407                     lappend difflcounts($ids) [list $noldlines($ids)]
2408                     set noldlines($ids) 0
2409                     set nnewlines($ids) 0
2410                     set diffinhunk($ids) 2
2411                 }
2412                 if {$match eq "-"} {
2413                     incr noldlines($ids)
2414                 } else {
2415                     incr nnewlines($ids)
2416                 }
2417             }
2418             # and if it's \ No newline at end of line, then what?
2419             return
2420         }
2421         # end of a hunk
2422         if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
2423             lappend difflcounts($ids) [list $noldlines($ids)]
2424         } elseif {$diffinhunk($ids) == 2
2425                   && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
2426             lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
2427         }
2428         set currenthunk($ids) [list $currentfile($ids) \
2429                                    $diffoldstart($ids) $diffnewstart($ids) \
2430                                    $diffoldlno($ids) $diffnewlno($ids) \
2431                                    $difflcounts($ids)]
2432         set diffinhunk($ids) 0
2433         # -1 = need to block, 0 = unblocked, 1 = is blocked
2434         set diffblocked($ids) -1
2435         processhunks
2436         if {$diffblocked($ids) == -1} {
2437             fileevent $f readable {}
2438             set diffblocked($ids) 1
2439         }
2440     }
2441
2442     if {$n < 0} {
2443         # eof
2444         if {!$diffblocked($ids)} {
2445             close $f
2446             set currentfile($ids) [llength $mergefilelist($diffmergeid)]
2447             set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
2448             processhunks
2449         }
2450     } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
2451         # start of a new file
2452         set currentfile($ids) \
2453             [lsearch -exact $mergefilelist($diffmergeid) $fname]
2454     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2455                    $line match f1l f1c f2l f2c rest]} {
2456         if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
2457             # start of a new hunk
2458             if {$f1l == 0 && $f1c == 0} {
2459                 set f1l 1
2460             }
2461             if {$f2l == 0 && $f2c == 0} {
2462                 set f2l 1
2463             }
2464             set diffinhunk($ids) 1
2465             set diffoldstart($ids) $f1l
2466             set diffnewstart($ids) $f2l
2467             set diffoldlno($ids) $f1l
2468             set diffnewlno($ids) $f2l
2469             set difflcounts($ids) {}
2470             set noldlines($ids) 0
2471             set nnewlines($ids) 0
2472         }
2473     }
2474 }
2475
2476 proc processhunks {} {
2477     global diffmergeid parents nparents currenthunk
2478     global mergefilelist diffblocked mergefds
2479     global grouphunks grouplinestart grouplineend groupfilenum
2480
2481     set nfiles [llength $mergefilelist($diffmergeid)]
2482     while 1 {
2483         set fi $nfiles
2484         set lno 0
2485         # look for the earliest hunk
2486         foreach p $parents($diffmergeid) {
2487             set ids [list $diffmergeid $p]
2488             if {![info exists currenthunk($ids)]} return
2489             set i [lindex $currenthunk($ids) 0]
2490             set l [lindex $currenthunk($ids) 2]
2491             if {$i < $fi || ($i == $fi && $l < $lno)} {
2492                 set fi $i
2493                 set lno $l
2494                 set pi $p
2495             }
2496         }
2497
2498         if {$fi < $nfiles} {
2499             set ids [list $diffmergeid $pi]
2500             set hunk $currenthunk($ids)
2501             unset currenthunk($ids)
2502             if {$diffblocked($ids) > 0} {
2503                 fileevent $mergefds($ids) readable \
2504                     [list getmergediffline $mergefds($ids) $ids $diffmergeid]
2505             }
2506             set diffblocked($ids) 0
2507
2508             if {[info exists groupfilenum] && $groupfilenum == $fi
2509                 && $lno <= $grouplineend} {
2510                 # add this hunk to the pending group
2511                 lappend grouphunks($pi) $hunk
2512                 set endln [lindex $hunk 4]
2513                 if {$endln > $grouplineend} {
2514                     set grouplineend $endln
2515                 }
2516                 continue
2517             }
2518         }
2519
2520         # succeeding stuff doesn't belong in this group, so
2521         # process the group now
2522         if {[info exists groupfilenum]} {
2523             processgroup
2524             unset groupfilenum
2525             unset grouphunks
2526         }
2527
2528         if {$fi >= $nfiles} break
2529
2530         # start a new group
2531         set groupfilenum $fi
2532         set grouphunks($pi) [list $hunk]
2533         set grouplinestart $lno
2534         set grouplineend [lindex $hunk 4]
2535     }
2536 }
2537
2538 proc processgroup {} {
2539     global groupfilelast groupfilenum difffilestart
2540     global mergefilelist diffmergeid ctext filelines
2541     global parents diffmergeid diffoffset
2542     global grouphunks grouplinestart grouplineend nparents
2543     global mergemax
2544
2545     $ctext conf -state normal
2546     set id $diffmergeid
2547     set f $groupfilenum
2548     if {$groupfilelast != $f} {
2549         $ctext insert end "\n"
2550         set here [$ctext index "end - 1c"]
2551         set difffilestart($f) $here
2552         set mark fmark.[expr {$f + 1}]
2553         $ctext mark set $mark $here
2554         $ctext mark gravity $mark left
2555         set header [lindex $mergefilelist($id) $f]
2556         set l [expr {(78 - [string length $header]) / 2}]
2557         set pad [string range "----------------------------------------" 1 $l]
2558         $ctext insert end "$pad $header $pad\n" filesep
2559         set groupfilelast $f
2560         foreach p $parents($id) {
2561             set diffoffset($p) 0
2562         }
2563     }
2564
2565     $ctext insert end "@@" msep
2566     set nlines [expr {$grouplineend - $grouplinestart}]
2567     set events {}
2568     set pnum 0
2569     foreach p $parents($id) {
2570         set startline [expr {$grouplinestart + $diffoffset($p)}]
2571         set ol $startline
2572         set nl $grouplinestart
2573         if {[info exists grouphunks($p)]} {
2574             foreach h $grouphunks($p) {
2575                 set l [lindex $h 2]
2576                 if {$nl < $l} {
2577                     for {} {$nl < $l} {incr nl} {
2578                         set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2579                         incr ol
2580                     }
2581                 }
2582                 foreach chunk [lindex $h 5] {
2583                     if {[llength $chunk] == 2} {
2584                         set olc [lindex $chunk 0]
2585                         set nlc [lindex $chunk 1]
2586                         set nnl [expr {$nl + $nlc}]
2587                         lappend events [list $nl $nnl $pnum $olc $nlc]
2588                         incr ol $olc
2589                         set nl $nnl
2590                     } else {
2591                         incr ol [lindex $chunk 0]
2592                         incr nl [lindex $chunk 0]
2593                     }
2594                 }
2595             }
2596         }
2597         if {$nl < $grouplineend} {
2598             for {} {$nl < $grouplineend} {incr nl} {
2599                 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2600                 incr ol
2601             }
2602         }
2603         set nlines [expr {$ol - $startline}]
2604         $ctext insert end " -$startline,$nlines" msep
2605         incr pnum
2606     }
2607
2608     set nlines [expr {$grouplineend - $grouplinestart}]
2609     $ctext insert end " +$grouplinestart,$nlines @@\n" msep
2610
2611     set events [lsort -integer -index 0 $events]
2612     set nevents [llength $events]
2613     set nmerge $nparents($diffmergeid)
2614     set l $grouplinestart
2615     for {set i 0} {$i < $nevents} {set i $j} {
2616         set nl [lindex $events $i 0]
2617         while {$l < $nl} {
2618             $ctext insert end " $filelines($id,$f,$l)\n"
2619             incr l
2620         }
2621         set e [lindex $events $i]
2622         set enl [lindex $e 1]
2623         set j $i
2624         set active {}
2625         while 1 {
2626             set pnum [lindex $e 2]
2627             set olc [lindex $e 3]
2628             set nlc [lindex $e 4]
2629             if {![info exists delta($pnum)]} {
2630                 set delta($pnum) [expr {$olc - $nlc}]
2631                 lappend active $pnum
2632             } else {
2633                 incr delta($pnum) [expr {$olc - $nlc}]
2634             }
2635             if {[incr j] >= $nevents} break
2636             set e [lindex $events $j]
2637             if {[lindex $e 0] >= $enl} break
2638             if {[lindex $e 1] > $enl} {
2639                 set enl [lindex $e 1]
2640             }
2641         }
2642         set nlc [expr {$enl - $l}]
2643         set ncol mresult
2644         set bestpn -1
2645         if {[llength $active] == $nmerge - 1} {
2646             # no diff for one of the parents, i.e. it's identical
2647             for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2648                 if {![info exists delta($pnum)]} {
2649                     if {$pnum < $mergemax} {
2650                         lappend ncol m$pnum
2651                     } else {
2652                         lappend ncol mmax
2653                     }
2654                     break
2655                 }
2656             }
2657         } elseif {[llength $active] == $nmerge} {
2658             # all parents are different, see if one is very similar
2659             set bestsim 30
2660             for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2661                 set sim [similarity $pnum $l $nlc $f \
2662                              [lrange $events $i [expr {$j-1}]]]
2663                 if {$sim > $bestsim} {
2664                     set bestsim $sim
2665                     set bestpn $pnum
2666                 }
2667             }
2668             if {$bestpn >= 0} {
2669                 lappend ncol m$bestpn
2670             }
2671         }
2672         set pnum -1
2673         foreach p $parents($id) {
2674             incr pnum
2675             if {![info exists delta($pnum)] || $pnum == $bestpn} continue
2676             set olc [expr {$nlc + $delta($pnum)}]
2677             set ol [expr {$l + $diffoffset($p)}]
2678             incr diffoffset($p) $delta($pnum)
2679             unset delta($pnum)
2680             for {} {$olc > 0} {incr olc -1} {
2681                 $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
2682                 incr ol
2683             }
2684         }
2685         set endl [expr {$l + $nlc}]
2686         if {$bestpn >= 0} {
2687             # show this pretty much as a normal diff
2688             set p [lindex $parents($id) $bestpn]
2689             set ol [expr {$l + $diffoffset($p)}]
2690             incr diffoffset($p) $delta($bestpn)
2691             unset delta($bestpn)
2692             for {set k $i} {$k < $j} {incr k} {
2693                 set e [lindex $events $k]
2694                 if {[lindex $e 2] != $bestpn} continue
2695                 set nl [lindex $e 0]
2696                 set ol [expr {$ol + $nl - $l}]
2697                 for {} {$l < $nl} {incr l} {
2698                     $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2699                 }
2700                 set c [lindex $e 3]
2701                 for {} {$c > 0} {incr c -1} {
2702                     $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn
2703                     incr ol
2704                 }
2705                 set nl [lindex $e 1]
2706                 for {} {$l < $nl} {incr l} {
2707                     $ctext insert end "+$filelines($id,$f,$l)\n" mresult
2708                 }
2709             }
2710         }
2711         for {} {$l < $endl} {incr l} {
2712             $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2713         }
2714     }
2715     while {$l < $grouplineend} {
2716         $ctext insert end " $filelines($id,$f,$l)\n"
2717         incr l
2718     }
2719     $ctext conf -state disabled
2720 }
2721
2722 proc similarity {pnum l nlc f events} {
2723     global diffmergeid parents diffoffset filelines
2724
2725     set id $diffmergeid
2726     set p [lindex $parents($id) $pnum]
2727     set ol [expr {$l + $diffoffset($p)}]
2728     set endl [expr {$l + $nlc}]
2729     set same 0
2730     set diff 0
2731     foreach e $events {
2732         if {[lindex $e 2] != $pnum} continue
2733         set nl [lindex $e 0]
2734         set ol [expr {$ol + $nl - $l}]
2735         for {} {$l < $nl} {incr l} {
2736             incr same [string length $filelines($id,$f,$l)]
2737             incr same
2738         }
2739         set oc [lindex $e 3]
2740         for {} {$oc > 0} {incr oc -1} {
2741             incr diff [string length $filelines($p,$f,$ol)]
2742             incr diff
2743             incr ol
2744         }
2745         set nl [lindex $e 1]
2746         for {} {$l < $nl} {incr l} {
2747             incr diff [string length $filelines($id,$f,$l)]
2748             incr diff
2749         }
2750     }
2751     for {} {$l < $endl} {incr l} {
2752         incr same [string length $filelines($id,$f,$l)]
2753         incr same
2754     }
2755     if {$same == 0} {
2756         return 0
2757     }
2758     return [expr {200 * $same / (2 * $same + $diff)}]
2759 }
2760
2761 proc startdiff {ids} {
2762     global treediffs diffids treepending diffmergeid
2763
2764     set diffids $ids
2765     catch {unset diffmergeid}
2766     if {![info exists treediffs($ids)]} {
2767         if {![info exists treepending]} {
2768             gettreediffs $ids
2769         }
2770     } else {
2771         addtocflist $ids
2772     }
2773 }
2774
2775 proc addtocflist {ids} {
2776     global treediffs cflist
2777     foreach f $treediffs($ids) {
2778         $cflist insert end $f
2779     }
2780     getblobdiffs $ids
2781 }
2782
2783 proc gettreediffs {ids} {
2784     global treediff parents treepending
2785     set treepending $ids
2786     set treediff {}
2787     set id [lindex $ids 0]
2788     set p [lindex $ids 1]
2789     if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
2790     fconfigure $gdtf -blocking 0
2791     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2792 }
2793
2794 proc gettreediffline {gdtf ids} {
2795     global treediff treediffs treepending diffids diffmergeid
2796
2797     set n [gets $gdtf line]
2798     if {$n < 0} {
2799         if {![eof $gdtf]} return
2800         close $gdtf
2801         set treediffs($ids) $treediff
2802         unset treepending
2803         if {$ids != $diffids} {
2804             gettreediffs $diffids
2805         } else {
2806             if {[info exists diffmergeid]} {
2807                 contmergediff $ids
2808             } else {
2809                 addtocflist $ids
2810             }
2811         }
2812         return
2813     }
2814     set file [lindex $line 5]
2815     lappend treediff $file
2816 }
2817
2818 proc getblobdiffs {ids} {
2819     global diffopts blobdifffd diffids env curdifftag curtagstart
2820     global difffilestart nextupdate diffinhdr treediffs
2821
2822     set id [lindex $ids 0]
2823     set p [lindex $ids 1]
2824     set env(GIT_DIFF_OPTS) $diffopts
2825     set cmd [list | git-diff-tree -r -p -C $p $id]
2826     if {[catch {set bdf [open $cmd r]} err]} {
2827         puts "error getting diffs: $err"
2828         return
2829     }
2830     set diffinhdr 0
2831     fconfigure $bdf -blocking 0
2832     set blobdifffd($ids) $bdf
2833     set curdifftag Comments
2834     set curtagstart 0.0
2835     catch {unset difffilestart}
2836     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2837     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2838 }
2839
2840 proc getblobdiffline {bdf ids} {
2841     global diffids blobdifffd ctext curdifftag curtagstart
2842     global diffnexthead diffnextnote difffilestart
2843     global nextupdate diffinhdr treediffs
2844     global gaudydiff
2845
2846     set n [gets $bdf line]
2847     if {$n < 0} {
2848         if {[eof $bdf]} {
2849             close $bdf
2850             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2851                 $ctext tag add $curdifftag $curtagstart end
2852             }
2853         }
2854         return
2855     }
2856     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2857         return
2858     }
2859     $ctext conf -state normal
2860     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2861         # start of a new file
2862         $ctext insert end "\n"
2863         $ctext tag add $curdifftag $curtagstart end
2864         set curtagstart [$ctext index "end - 1c"]
2865         set header $newname
2866         set here [$ctext index "end - 1c"]
2867         set i [lsearch -exact $treediffs($diffids) $fname]
2868         if {$i >= 0} {
2869             set difffilestart($i) $here
2870             incr i
2871             $ctext mark set fmark.$i $here
2872             $ctext mark gravity fmark.$i left
2873         }
2874         if {$newname != $fname} {
2875             set i [lsearch -exact $treediffs($diffids) $newname]
2876             if {$i >= 0} {
2877                 set difffilestart($i) $here
2878                 incr i
2879                 $ctext mark set fmark.$i $here
2880                 $ctext mark gravity fmark.$i left
2881             }
2882         }
2883         set curdifftag "f:$fname"
2884         $ctext tag delete $curdifftag
2885         set l [expr {(78 - [string length $header]) / 2}]
2886         set pad [string range "----------------------------------------" 1 $l]
2887         $ctext insert end "$pad $header $pad\n" filesep
2888         set diffinhdr 1
2889     } elseif {[regexp {^(---|\+\+\+)} $line]} {
2890         set diffinhdr 0
2891     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2892                    $line match f1l f1c f2l f2c rest]} {
2893         if {$gaudydiff} {
2894             $ctext insert end "\t" hunksep
2895             $ctext insert end "    $f1l    " d0 "    $f2l    " d1
2896             $ctext insert end "    $rest \n" hunksep
2897         } else {
2898             $ctext insert end "$line\n" hunksep
2899         }
2900         set diffinhdr 0
2901     } else {
2902         set x [string range $line 0 0]
2903         if {$x == "-" || $x == "+"} {
2904             set tag [expr {$x == "+"}]
2905             if {$gaudydiff} {
2906                 set line [string range $line 1 end]
2907             }
2908             $ctext insert end "$line\n" d$tag
2909         } elseif {$x == " "} {
2910             if {$gaudydiff} {
2911                 set line [string range $line 1 end]
2912             }
2913             $ctext insert end "$line\n"
2914         } elseif {$diffinhdr || $x == "\\"} {
2915             # e.g. "\ No newline at end of file"
2916             $ctext insert end "$line\n" filesep
2917         } else {
2918             # Something else we don't recognize
2919             if {$curdifftag != "Comments"} {
2920                 $ctext insert end "\n"
2921                 $ctext tag add $curdifftag $curtagstart end
2922                 set curtagstart [$ctext index "end - 1c"]
2923                 set curdifftag Comments
2924             }
2925             $ctext insert end "$line\n" filesep
2926         }
2927     }
2928     $ctext conf -state disabled
2929     if {[clock clicks -milliseconds] >= $nextupdate} {
2930         incr nextupdate 100
2931         fileevent $bdf readable {}
2932         update
2933         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2934     }
2935 }
2936
2937 proc nextfile {} {
2938     global difffilestart ctext
2939     set here [$ctext index @0,0]
2940     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2941         if {[$ctext compare $difffilestart($i) > $here]} {
2942             if {![info exists pos]
2943                 || [$ctext compare $difffilestart($i) < $pos]} {
2944                 set pos $difffilestart($i)
2945             }
2946         }
2947     }
2948     if {[info exists pos]} {
2949         $ctext yview $pos
2950     }
2951 }
2952
2953 proc listboxsel {} {
2954     global ctext cflist currentid
2955     if {![info exists currentid]} return
2956     set sel [lsort [$cflist curselection]]
2957     if {$sel eq {}} return
2958     set first [lindex $sel 0]
2959     catch {$ctext yview fmark.$first}
2960 }
2961
2962 proc setcoords {} {
2963     global linespc charspc canvx0 canvy0 mainfont
2964     global xspc1 xspc2 lthickness
2965
2966     set linespc [font metrics $mainfont -linespace]
2967     set charspc [font measure $mainfont "m"]
2968     set canvy0 [expr 3 + 0.5 * $linespc]
2969     set canvx0 [expr 3 + 0.5 * $linespc]
2970     set lthickness [expr {int($linespc / 9) + 1}]
2971     set xspc1(0) $linespc
2972     set xspc2 $linespc
2973 }
2974
2975 proc redisplay {} {
2976     global stopped redisplaying phase
2977     if {$stopped > 1} return
2978     if {$phase == "getcommits"} return
2979     set redisplaying 1
2980     if {$phase == "drawgraph" || $phase == "incrdraw"} {
2981         set stopped 1
2982     } else {
2983         drawgraph
2984     }
2985 }
2986
2987 proc incrfont {inc} {
2988     global mainfont namefont textfont ctext canv phase
2989     global stopped entries
2990     unmarkmatches
2991     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2992     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2993     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2994     setcoords
2995     $ctext conf -font $textfont
2996     $ctext tag conf filesep -font [concat $textfont bold]
2997     foreach e $entries {
2998         $e conf -font $mainfont
2999     }
3000     if {$phase == "getcommits"} {
3001         $canv itemconf textitems -font $mainfont
3002     }
3003     redisplay
3004 }
3005
3006 proc clearsha1 {} {
3007     global sha1entry sha1string
3008     if {[string length $sha1string] == 40} {
3009         $sha1entry delete 0 end
3010     }
3011 }
3012
3013 proc sha1change {n1 n2 op} {
3014     global sha1string currentid sha1but
3015     if {$sha1string == {}
3016         || ([info exists currentid] && $sha1string == $currentid)} {
3017         set state disabled
3018     } else {
3019         set state normal
3020     }
3021     if {[$sha1but cget -state] == $state} return
3022     if {$state == "normal"} {
3023         $sha1but conf -state normal -relief raised -text "Goto: "
3024     } else {
3025         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3026     }
3027 }
3028
3029 proc gotocommit {} {
3030     global sha1string currentid idline tagids
3031     global lineid numcommits
3032
3033     if {$sha1string == {}
3034         || ([info exists currentid] && $sha1string == $currentid)} return
3035     if {[info exists tagids($sha1string)]} {
3036         set id $tagids($sha1string)
3037     } else {
3038         set id [string tolower $sha1string]
3039         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3040             set matches {}
3041             for {set l 0} {$l < $numcommits} {incr l} {
3042                 if {[string match $id* $lineid($l)]} {
3043                     lappend matches $lineid($l)
3044                 }
3045             }
3046             if {$matches ne {}} {
3047                 if {[llength $matches] > 1} {
3048                     error_popup "Short SHA1 id $id is ambiguous"
3049                     return
3050                 }
3051                 set id [lindex $matches 0]
3052             }
3053         }
3054     }
3055     if {[info exists idline($id)]} {
3056         selectline $idline($id) 1
3057         return
3058     }
3059     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3060         set type "SHA1 id"
3061     } else {
3062         set type "Tag"
3063     }
3064     error_popup "$type $sha1string is not known"
3065 }
3066
3067 proc lineenter {x y id} {
3068     global hoverx hovery hoverid hovertimer
3069     global commitinfo canv
3070
3071     if {![info exists commitinfo($id)]} return
3072     set hoverx $x
3073     set hovery $y
3074     set hoverid $id
3075     if {[info exists hovertimer]} {
3076         after cancel $hovertimer
3077     }
3078     set hovertimer [after 500 linehover]
3079     $canv delete hover
3080 }
3081
3082 proc linemotion {x y id} {
3083     global hoverx hovery hoverid hovertimer
3084
3085     if {[info exists hoverid] && $id == $hoverid} {
3086         set hoverx $x
3087         set hovery $y
3088         if {[info exists hovertimer]} {
3089             after cancel $hovertimer
3090         }
3091         set hovertimer [after 500 linehover]
3092     }
3093 }
3094
3095 proc lineleave {id} {
3096     global hoverid hovertimer canv
3097
3098     if {[info exists hoverid] && $id == $hoverid} {
3099         $canv delete hover
3100         if {[info exists hovertimer]} {
3101             after cancel $hovertimer
3102             unset hovertimer
3103         }
3104         unset hoverid
3105     }
3106 }
3107
3108 proc linehover {} {
3109     global hoverx hovery hoverid hovertimer
3110     global canv linespc lthickness
3111     global commitinfo mainfont
3112
3113     set text [lindex $commitinfo($hoverid) 0]
3114     set ymax [lindex [$canv cget -scrollregion] 3]
3115     if {$ymax == {}} return
3116     set yfrac [lindex [$canv yview] 0]
3117     set x [expr {$hoverx + 2 * $linespc}]
3118     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3119     set x0 [expr {$x - 2 * $lthickness}]
3120     set y0 [expr {$y - 2 * $lthickness}]
3121     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3122     set y1 [expr {$y + $linespc + 2 * $lthickness}]
3123     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3124                -fill \#ffff80 -outline black -width 1 -tags hover]
3125     $canv raise $t
3126     set t [$canv create text $x $y -anchor nw -text $text -tags hover]
3127     $canv raise $t
3128 }
3129
3130 proc lineclick {x y id isnew} {
3131     global ctext commitinfo children cflist canv
3132
3133     unmarkmatches
3134     unselectline
3135     if {$isnew} {
3136         addtohistory [list lineclick $x $x $id 0]
3137     }
3138     $canv delete hover
3139     # fill the details pane with info about this line
3140     $ctext conf -state normal
3141     $ctext delete 0.0 end
3142     $ctext tag conf link -foreground blue -underline 1
3143     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3144     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3145     $ctext insert end "Parent:\t"
3146     $ctext insert end $id [list link link0]
3147     $ctext tag bind link0 <1> [list selbyid $id]
3148     set info $commitinfo($id)
3149     $ctext insert end "\n\t[lindex $info 0]\n"
3150     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3151     $ctext insert end "\tDate:\t[lindex $info 2]\n"
3152     if {[info exists children($id)]} {
3153         $ctext insert end "\nChildren:"
3154         set i 0
3155         foreach child $children($id) {
3156             incr i
3157             set info $commitinfo($child)
3158             $ctext insert end "\n\t"
3159             $ctext insert end $child [list link link$i]
3160             $ctext tag bind link$i <1> [list selbyid $child]
3161             $ctext insert end "\n\t[lindex $info 0]"
3162             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3163             $ctext insert end "\n\tDate:\t[lindex $info 2]\n"
3164         }
3165     }
3166     $ctext conf -state disabled
3167
3168     $cflist delete 0 end
3169 }
3170
3171 proc selbyid {id} {
3172     global idline
3173     if {[info exists idline($id)]} {
3174         selectline $idline($id) 1
3175     }
3176 }
3177
3178 proc mstime {} {
3179     global startmstime
3180     if {![info exists startmstime]} {
3181         set startmstime [clock clicks -milliseconds]
3182     }
3183     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3184 }
3185
3186 proc rowmenu {x y id} {
3187     global rowctxmenu idline selectedline rowmenuid
3188
3189     if {![info exists selectedline] || $idline($id) eq $selectedline} {
3190         set state disabled
3191     } else {
3192         set state normal
3193     }
3194     $rowctxmenu entryconfigure 0 -state $state
3195     $rowctxmenu entryconfigure 1 -state $state
3196     $rowctxmenu entryconfigure 2 -state $state
3197     set rowmenuid $id
3198     tk_popup $rowctxmenu $x $y
3199 }
3200
3201 proc diffvssel {dirn} {
3202     global rowmenuid selectedline lineid
3203
3204     if {![info exists selectedline]} return
3205     if {$dirn} {
3206         set oldid $lineid($selectedline)
3207         set newid $rowmenuid
3208     } else {
3209         set oldid $rowmenuid
3210         set newid $lineid($selectedline)
3211     }
3212     addtohistory [list doseldiff $oldid $newid]
3213     doseldiff $oldid $newid
3214 }
3215
3216 proc doseldiff {oldid newid} {
3217     global ctext cflist
3218     global commitinfo
3219
3220     $ctext conf -state normal
3221     $ctext delete 0.0 end
3222     $ctext mark set fmark.0 0.0
3223     $ctext mark gravity fmark.0 left
3224     $cflist delete 0 end
3225     $cflist insert end "Top"
3226     $ctext insert end "From "
3227     $ctext tag conf link -foreground blue -underline 1
3228     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3229     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3230     $ctext tag bind link0 <1> [list selbyid $oldid]
3231     $ctext insert end $oldid [list link link0]
3232     $ctext insert end "\n     "
3233     $ctext insert end [lindex $commitinfo($oldid) 0]
3234     $ctext insert end "\n\nTo   "
3235     $ctext tag bind link1 <1> [list selbyid $newid]
3236     $ctext insert end $newid [list link link1]
3237     $ctext insert end "\n     "
3238     $ctext insert end [lindex $commitinfo($newid) 0]
3239     $ctext insert end "\n"
3240     $ctext conf -state disabled
3241     $ctext tag delete Comments
3242     $ctext tag remove found 1.0 end
3243     startdiff [list $newid $oldid]
3244 }
3245
3246 proc mkpatch {} {
3247     global rowmenuid currentid commitinfo patchtop patchnum
3248
3249     if {![info exists currentid]} return
3250     set oldid $currentid
3251     set oldhead [lindex $commitinfo($oldid) 0]
3252     set newid $rowmenuid
3253     set newhead [lindex $commitinfo($newid) 0]
3254     set top .patch
3255     set patchtop $top
3256     catch {destroy $top}
3257     toplevel $top
3258     label $top.title -text "Generate patch"
3259     grid $top.title - -pady 10
3260     label $top.from -text "From:"
3261     entry $top.fromsha1 -width 40 -relief flat
3262     $top.fromsha1 insert 0 $oldid
3263     $top.fromsha1 conf -state readonly
3264     grid $top.from $top.fromsha1 -sticky w
3265     entry $top.fromhead -width 60 -relief flat
3266     $top.fromhead insert 0 $oldhead
3267     $top.fromhead conf -state readonly
3268     grid x $top.fromhead -sticky w
3269     label $top.to -text "To:"
3270     entry $top.tosha1 -width 40 -relief flat
3271     $top.tosha1 insert 0 $newid
3272     $top.tosha1 conf -state readonly
3273     grid $top.to $top.tosha1 -sticky w
3274     entry $top.tohead -width 60 -relief flat
3275     $top.tohead insert 0 $newhead
3276     $top.tohead conf -state readonly
3277     grid x $top.tohead -sticky w
3278     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3279     grid $top.rev x -pady 10
3280     label $top.flab -text "Output file:"
3281     entry $top.fname -width 60
3282     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3283     incr patchnum
3284     grid $top.flab $top.fname -sticky w
3285     frame $top.buts
3286     button $top.buts.gen -text "Generate" -command mkpatchgo
3287     button $top.buts.can -text "Cancel" -command mkpatchcan
3288     grid $top.buts.gen $top.buts.can
3289     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3290     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3291     grid $top.buts - -pady 10 -sticky ew
3292     focus $top.fname
3293 }
3294
3295 proc mkpatchrev {} {
3296     global patchtop
3297
3298     set oldid [$patchtop.fromsha1 get]
3299     set oldhead [$patchtop.fromhead get]
3300     set newid [$patchtop.tosha1 get]
3301     set newhead [$patchtop.tohead get]
3302     foreach e [list fromsha1 fromhead tosha1 tohead] \
3303             v [list $newid $newhead $oldid $oldhead] {
3304         $patchtop.$e conf -state normal
3305         $patchtop.$e delete 0 end
3306         $patchtop.$e insert 0 $v
3307         $patchtop.$e conf -state readonly
3308     }
3309 }
3310
3311 proc mkpatchgo {} {
3312     global patchtop
3313
3314     set oldid [$patchtop.fromsha1 get]
3315     set newid [$patchtop.tosha1 get]
3316     set fname [$patchtop.fname get]
3317     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3318         error_popup "Error creating patch: $err"
3319     }
3320     catch {destroy $patchtop}
3321     unset patchtop
3322 }
3323
3324 proc mkpatchcan {} {
3325     global patchtop
3326
3327     catch {destroy $patchtop}
3328     unset patchtop
3329 }
3330
3331 proc mktag {} {
3332     global rowmenuid mktagtop commitinfo
3333
3334     set top .maketag
3335     set mktagtop $top
3336     catch {destroy $top}
3337     toplevel $top
3338     label $top.title -text "Create tag"
3339     grid $top.title - -pady 10
3340     label $top.id -text "ID:"
3341     entry $top.sha1 -width 40 -relief flat
3342     $top.sha1 insert 0 $rowmenuid
3343     $top.sha1 conf -state readonly
3344     grid $top.id $top.sha1 -sticky w
3345     entry $top.head -width 60 -relief flat
3346     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3347     $top.head conf -state readonly
3348     grid x $top.head -sticky w
3349     label $top.tlab -text "Tag name:"
3350     entry $top.tag -width 60
3351     grid $top.tlab $top.tag -sticky w
3352     frame $top.buts
3353     button $top.buts.gen -text "Create" -command mktaggo
3354     button $top.buts.can -text "Cancel" -command mktagcan
3355     grid $top.buts.gen $top.buts.can
3356     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3357     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3358     grid $top.buts - -pady 10 -sticky ew
3359     focus $top.tag
3360 }
3361
3362 proc domktag {} {
3363     global mktagtop env tagids idtags
3364
3365     set id [$mktagtop.sha1 get]
3366     set tag [$mktagtop.tag get]
3367     if {$tag == {}} {
3368         error_popup "No tag name specified"
3369         return
3370     }
3371     if {[info exists tagids($tag)]} {
3372         error_popup "Tag \"$tag\" already exists"
3373         return
3374     }
3375     if {[catch {
3376         set dir [gitdir]
3377         set fname [file join $dir "refs/tags" $tag]
3378         set f [open $fname w]
3379         puts $f $id
3380         close $f
3381     } err]} {
3382         error_popup "Error creating tag: $err"
3383         return
3384     }
3385
3386     set tagids($tag) $id
3387     lappend idtags($id) $tag
3388     redrawtags $id
3389 }
3390
3391 proc redrawtags {id} {
3392     global canv linehtag idline idpos selectedline
3393
3394     if {![info exists idline($id)]} return
3395     $canv delete tag.$id
3396     set xt [eval drawtags $id $idpos($id)]
3397     $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3398     if {[info exists selectedline] && $selectedline == $idline($id)} {
3399         selectline $selectedline 0
3400     }
3401 }
3402
3403 proc mktagcan {} {
3404     global mktagtop
3405
3406     catch {destroy $mktagtop}
3407     unset mktagtop
3408 }
3409
3410 proc mktaggo {} {
3411     domktag
3412     mktagcan
3413 }
3414
3415 proc writecommit {} {
3416     global rowmenuid wrcomtop commitinfo wrcomcmd
3417
3418     set top .writecommit
3419     set wrcomtop $top
3420     catch {destroy $top}
3421     toplevel $top
3422     label $top.title -text "Write commit to file"
3423     grid $top.title - -pady 10
3424     label $top.id -text "ID:"
3425     entry $top.sha1 -width 40 -relief flat
3426     $top.sha1 insert 0 $rowmenuid
3427     $top.sha1 conf -state readonly
3428     grid $top.id $top.sha1 -sticky w
3429     entry $top.head -width 60 -relief flat
3430     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3431     $top.head conf -state readonly
3432     grid x $top.head -sticky w
3433     label $top.clab -text "Command:"
3434     entry $top.cmd -width 60 -textvariable wrcomcmd
3435     grid $top.clab $top.cmd -sticky w -pady 10
3436     label $top.flab -text "Output file:"
3437     entry $top.fname -width 60
3438     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3439     grid $top.flab $top.fname -sticky w
3440     frame $top.buts
3441     button $top.buts.gen -text "Write" -command wrcomgo
3442     button $top.buts.can -text "Cancel" -command wrcomcan
3443     grid $top.buts.gen $top.buts.can
3444     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3445     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3446     grid $top.buts - -pady 10 -sticky ew
3447     focus $top.fname
3448 }
3449
3450 proc wrcomgo {} {
3451     global wrcomtop
3452
3453     set id [$wrcomtop.sha1 get]
3454     set cmd "echo $id | [$wrcomtop.cmd get]"
3455     set fname [$wrcomtop.fname get]
3456     if {[catch {exec sh -c $cmd >$fname &} err]} {
3457         error_popup "Error writing commit: $err"
3458     }
3459     catch {destroy $wrcomtop}
3460     unset wrcomtop
3461 }
3462
3463 proc wrcomcan {} {
3464     global wrcomtop
3465
3466     catch {destroy $wrcomtop}
3467     unset wrcomtop
3468 }
3469
3470 proc listrefs {id} {
3471     global idtags idheads idotherrefs
3472
3473     set x {}
3474     if {[info exists idtags($id)]} {
3475         set x $idtags($id)
3476     }
3477     set y {}
3478     if {[info exists idheads($id)]} {
3479         set y $idheads($id)
3480     }
3481     set z {}
3482     if {[info exists idotherrefs($id)]} {
3483         set z $idotherrefs($id)
3484     }
3485     return [list $x $y $z]
3486 }
3487
3488 proc rereadrefs {} {
3489     global idtags idheads idotherrefs
3490     global tagids headids otherrefids
3491
3492     set refids [concat [array names idtags] \
3493                     [array names idheads] [array names idotherrefs]]
3494     foreach id $refids {
3495         if {![info exists ref($id)]} {
3496             set ref($id) [listrefs $id]
3497         }
3498     }
3499     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
3500         catch {unset $v}
3501     }
3502     readrefs
3503     set refids [lsort -unique [concat $refids [array names idtags] \
3504                         [array names idheads] [array names idotherrefs]]]
3505     foreach id $refids {
3506         set v [listrefs $id]
3507         if {![info exists ref($id)] || $ref($id) != $v} {
3508             redrawtags $id
3509         }
3510     }
3511 }
3512
3513 proc showtag {tag isnew} {
3514     global ctext cflist tagcontents tagids linknum
3515
3516     if {$isnew} {
3517         addtohistory [list showtag $tag 0]
3518     }
3519     $ctext conf -state normal
3520     $ctext delete 0.0 end
3521     set linknum 0
3522     if {[info exists tagcontents($tag)]} {
3523         set text $tagcontents($tag)
3524     } else {
3525         set text "Tag: $tag\nId:  $tagids($tag)"
3526     }
3527     appendwithlinks $text
3528     $ctext conf -state disabled
3529     $cflist delete 0 end
3530 }
3531
3532 proc doquit {} {
3533     global stopped
3534     set stopped 100
3535     destroy .
3536 }
3537
3538 # defaults...
3539 set datemode 0
3540 set boldnames 0
3541 set diffopts "-U 5 -p"
3542 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3543
3544 set mainfont {Helvetica 9}
3545 set textfont {Courier 9}
3546 set findmergefiles 0
3547 set gaudydiff 0
3548 set maxgraphpct 50
3549 set maxwidth 16
3550
3551 set colors {green red blue magenta darkgrey brown orange}
3552
3553 catch {source ~/.gitk}
3554
3555 set namefont $mainfont
3556 if {$boldnames} {
3557     lappend namefont bold
3558 }
3559
3560 set revtreeargs {}
3561 foreach arg $argv {
3562     switch -regexp -- $arg {
3563         "^$" { }
3564         "^-b" { set boldnames 1 }
3565         "^-d" { set datemode 1 }
3566         default {
3567             lappend revtreeargs $arg
3568         }
3569     }
3570 }
3571
3572 set history {}
3573 set historyindex 0
3574
3575 set stopped 0
3576 set redisplaying 0
3577 set stuffsaved 0
3578 set patchnum 0
3579 setcoords
3580 makewindow
3581 readrefs
3582 getcommits $revtreeargs