gitk

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