gitk

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