gitk

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