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