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)] 1
2169     } elseif {$nparents($id) > 1} {
2170         mergediff $id 1
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 singlecommit} {
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 {} $singlecommit
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 singlecommit} {
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 $singlecommit
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 singlecommit} {
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 $singlecommit
2773         }
2774     } else {
2775         addtocflist $ids $singlecommit
2776     }
2777 }
2778
2779 proc addtocflist {ids singlecommit} {
2780     global treediffs cflist
2781     foreach f $treediffs($ids) {
2782         $cflist insert end $f
2783     }
2784     getblobdiffs $ids $singlecommit
2785 }
2786
2787 proc gettreediffs {ids singlecommit} {
2788     global treediff parents treepending
2789     set treepending $ids
2790     set treediff {}
2791     set id [lindex $ids 0]
2792     if {$singlecommit == 1} {
2793         set range "$id"
2794     } else {
2795         set p [lindex $ids 1]
2796         set range "$p $id"
2797     }
2798     if [catch {set gdtf [open "|git-diff-tree --no-commit-id -r $range" r]}] return
2799     fconfigure $gdtf -blocking 0
2800     fileevent $gdtf readable [list gettreediffline $gdtf $ids $singlecommit]
2801 }
2802
2803 proc gettreediffline {gdtf ids singlecommit} {
2804     global treediff treediffs treepending diffids diffmergeid
2805
2806     set n [gets $gdtf line]
2807     if {$n < 0} {
2808         if {![eof $gdtf]} return
2809         close $gdtf
2810         set treediffs($ids) $treediff
2811         unset treepending
2812         if {$ids != $diffids} {
2813             gettreediffs $diffids $singlecommit
2814         } else {
2815             if {[info exists diffmergeid]} {
2816                 contmergediff $ids $singlecommit
2817             } else {
2818                 addtocflist $ids $singlecommit
2819             }
2820         }
2821         return
2822     }
2823     set file [lindex $line 5]
2824     lappend treediff $file
2825 }
2826
2827 proc getblobdiffs {ids singlecommit} {
2828     global diffopts blobdifffd diffids env curdifftag curtagstart
2829     global difffilestart nextupdate diffinhdr treediffs
2830
2831     set id [lindex $ids 0]
2832     set env(GIT_DIFF_OPTS) $diffopts
2833     if {$singlecommit == 1} {
2834         set cmd [list | git-diff-tree --no-commit-id -r -p -C $id]
2835     } else {
2836         set p [lindex $ids 1]
2837         set cmd [list | git-diff-tree --no-commit-id -r -p -C $p $id]
2838     }
2839     if {[catch {set bdf [open $cmd r]} err]} {
2840         puts "error getting diffs: $err"
2841         return
2842     }
2843     set diffinhdr 0
2844     fconfigure $bdf -blocking 0
2845     set blobdifffd($ids) $bdf
2846     set curdifftag Comments
2847     set curtagstart 0.0
2848     catch {unset difffilestart}
2849     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2850     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2851 }
2852
2853 proc getblobdiffline {bdf ids} {
2854     global diffids blobdifffd ctext curdifftag curtagstart
2855     global diffnexthead diffnextnote difffilestart
2856     global nextupdate diffinhdr treediffs
2857     global gaudydiff
2858
2859     set n [gets $bdf line]
2860     if {$n < 0} {
2861         if {[eof $bdf]} {
2862             close $bdf
2863             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2864                 $ctext tag add $curdifftag $curtagstart end
2865             }
2866         }
2867         return
2868     }
2869     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2870         return
2871     }
2872     $ctext conf -state normal
2873     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2874         # start of a new file
2875         $ctext insert end "\n"
2876         $ctext tag add $curdifftag $curtagstart end
2877         set curtagstart [$ctext index "end - 1c"]
2878         set header $newname
2879         set here [$ctext index "end - 1c"]
2880         set i [lsearch -exact $treediffs($diffids) $fname]
2881         if {$i >= 0} {
2882             set difffilestart($i) $here
2883             incr i
2884             $ctext mark set fmark.$i $here
2885             $ctext mark gravity fmark.$i left
2886         }
2887         if {$newname != $fname} {
2888             set i [lsearch -exact $treediffs($diffids) $newname]
2889             if {$i >= 0} {
2890                 set difffilestart($i) $here
2891                 incr i
2892                 $ctext mark set fmark.$i $here
2893                 $ctext mark gravity fmark.$i left
2894             }
2895         }
2896         set curdifftag "f:$fname"
2897         $ctext tag delete $curdifftag
2898         set l [expr {(78 - [string length $header]) / 2}]
2899         set pad [string range "----------------------------------------" 1 $l]
2900         $ctext insert end "$pad $header $pad\n" filesep
2901         set diffinhdr 1
2902     } elseif {[regexp {^(---|\+\+\+)} $line]} {
2903         set diffinhdr 0
2904     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2905                    $line match f1l f1c f2l f2c rest]} {
2906         if {$gaudydiff} {
2907             $ctext insert end "\t" hunksep
2908             $ctext insert end "    $f1l    " d0 "    $f2l    " d1
2909             $ctext insert end "    $rest \n" hunksep
2910         } else {
2911             $ctext insert end "$line\n" hunksep
2912         }
2913         set diffinhdr 0
2914     } else {
2915         set x [string range $line 0 0]
2916         if {$x == "-" || $x == "+"} {
2917             set tag [expr {$x == "+"}]
2918             if {$gaudydiff} {
2919                 set line [string range $line 1 end]
2920             }
2921             $ctext insert end "$line\n" d$tag
2922         } elseif {$x == " "} {
2923             if {$gaudydiff} {
2924                 set line [string range $line 1 end]
2925             }
2926             $ctext insert end "$line\n"
2927         } elseif {$diffinhdr || $x == "\\"} {
2928             # e.g. "\ No newline at end of file"
2929             $ctext insert end "$line\n" filesep
2930         } else {
2931             # Something else we don't recognize
2932             if {$curdifftag != "Comments"} {
2933                 $ctext insert end "\n"
2934                 $ctext tag add $curdifftag $curtagstart end
2935                 set curtagstart [$ctext index "end - 1c"]
2936                 set curdifftag Comments
2937             }
2938             $ctext insert end "$line\n" filesep
2939         }
2940     }
2941     $ctext conf -state disabled
2942     if {[clock clicks -milliseconds] >= $nextupdate} {
2943         incr nextupdate 100
2944         fileevent $bdf readable {}
2945         update
2946         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2947     }
2948 }
2949
2950 proc nextfile {} {
2951     global difffilestart ctext
2952     set here [$ctext index @0,0]
2953     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2954         if {[$ctext compare $difffilestart($i) > $here]} {
2955             if {![info exists pos]
2956                 || [$ctext compare $difffilestart($i) < $pos]} {
2957                 set pos $difffilestart($i)
2958             }
2959         }
2960     }
2961     if {[info exists pos]} {
2962         $ctext yview $pos
2963     }
2964 }
2965
2966 proc listboxsel {} {
2967     global ctext cflist currentid
2968     if {![info exists currentid]} return
2969     set sel [lsort [$cflist curselection]]
2970     if {$sel eq {}} return
2971     set first [lindex $sel 0]
2972     catch {$ctext yview fmark.$first}
2973 }
2974
2975 proc setcoords {} {
2976     global linespc charspc canvx0 canvy0 mainfont
2977     global xspc1 xspc2 lthickness
2978
2979     set linespc [font metrics $mainfont -linespace]
2980     set charspc [font measure $mainfont "m"]
2981     set canvy0 [expr {3 + 0.5 * $linespc}]
2982     set canvx0 [expr {3 + 0.5 * $linespc}]
2983     set lthickness [expr {int($linespc / 9) + 1}]
2984     set xspc1(0) $linespc
2985     set xspc2 $linespc
2986 }
2987
2988 proc redisplay {} {
2989     global stopped redisplaying phase
2990     if {$stopped > 1} return
2991     if {$phase == "getcommits"} return
2992     set redisplaying 1
2993     if {$phase == "drawgraph" || $phase == "incrdraw"} {
2994         set stopped 1
2995     } else {
2996         drawgraph
2997     }
2998 }
2999
3000 proc incrfont {inc} {
3001     global mainfont namefont textfont ctext canv phase
3002     global stopped entries
3003     unmarkmatches
3004     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3005     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3006     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3007     setcoords
3008     $ctext conf -font $textfont
3009     $ctext tag conf filesep -font [concat $textfont bold]
3010     foreach e $entries {
3011         $e conf -font $mainfont
3012     }
3013     if {$phase == "getcommits"} {
3014         $canv itemconf textitems -font $mainfont
3015     }
3016     redisplay
3017 }
3018
3019 proc clearsha1 {} {
3020     global sha1entry sha1string
3021     if {[string length $sha1string] == 40} {
3022         $sha1entry delete 0 end
3023     }
3024 }
3025
3026 proc sha1change {n1 n2 op} {
3027     global sha1string currentid sha1but
3028     if {$sha1string == {}
3029         || ([info exists currentid] && $sha1string == $currentid)} {
3030         set state disabled
3031     } else {
3032         set state normal
3033     }
3034     if {[$sha1but cget -state] == $state} return
3035     if {$state == "normal"} {
3036         $sha1but conf -state normal -relief raised -text "Goto: "
3037     } else {
3038         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3039     }
3040 }
3041
3042 proc gotocommit {} {
3043     global sha1string currentid idline tagids
3044     global lineid numcommits
3045
3046     if {$sha1string == {}
3047         || ([info exists currentid] && $sha1string == $currentid)} return
3048     if {[info exists tagids($sha1string)]} {
3049         set id $tagids($sha1string)
3050     } else {
3051         set id [string tolower $sha1string]
3052         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3053             set matches {}
3054             for {set l 0} {$l < $numcommits} {incr l} {
3055                 if {[string match $id* $lineid($l)]} {
3056                     lappend matches $lineid($l)
3057                 }
3058             }
3059             if {$matches ne {}} {
3060                 if {[llength $matches] > 1} {
3061                     error_popup "Short SHA1 id $id is ambiguous"
3062                     return
3063                 }
3064                 set id [lindex $matches 0]
3065             }
3066         }
3067     }
3068     if {[info exists idline($id)]} {
3069         selectline $idline($id) 1
3070         return
3071     }
3072     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3073         set type "SHA1 id"
3074     } else {
3075         set type "Tag"
3076     }
3077     error_popup "$type $sha1string is not known"
3078 }
3079
3080 proc lineenter {x y id} {
3081     global hoverx hovery hoverid hovertimer
3082     global commitinfo canv
3083
3084     if {![info exists commitinfo($id)]} return
3085     set hoverx $x
3086     set hovery $y
3087     set hoverid $id
3088     if {[info exists hovertimer]} {
3089         after cancel $hovertimer
3090     }
3091     set hovertimer [after 500 linehover]
3092     $canv delete hover
3093 }
3094
3095 proc linemotion {x y id} {
3096     global hoverx hovery hoverid hovertimer
3097
3098     if {[info exists hoverid] && $id == $hoverid} {
3099         set hoverx $x
3100         set hovery $y
3101         if {[info exists hovertimer]} {
3102             after cancel $hovertimer
3103         }
3104         set hovertimer [after 500 linehover]
3105     }
3106 }
3107
3108 proc lineleave {id} {
3109     global hoverid hovertimer canv
3110
3111     if {[info exists hoverid] && $id == $hoverid} {
3112         $canv delete hover
3113         if {[info exists hovertimer]} {
3114             after cancel $hovertimer
3115             unset hovertimer
3116         }
3117         unset hoverid
3118     }
3119 }
3120
3121 proc linehover {} {
3122     global hoverx hovery hoverid hovertimer
3123     global canv linespc lthickness
3124     global commitinfo mainfont
3125
3126     set text [lindex $commitinfo($hoverid) 0]
3127     set ymax [lindex [$canv cget -scrollregion] 3]
3128     if {$ymax == {}} return
3129     set yfrac [lindex [$canv yview] 0]
3130     set x [expr {$hoverx + 2 * $linespc}]
3131     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3132     set x0 [expr {$x - 2 * $lthickness}]
3133     set y0 [expr {$y - 2 * $lthickness}]
3134     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3135     set y1 [expr {$y + $linespc + 2 * $lthickness}]
3136     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3137                -fill \#ffff80 -outline black -width 1 -tags hover]
3138     $canv raise $t
3139     set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3140     $canv raise $t
3141 }
3142
3143 proc clickisonarrow {id y} {
3144     global mainline mainlinearrow sidelines lthickness
3145
3146     set thresh [expr {2 * $lthickness + 6}]
3147     if {[info exists mainline($id)]} {
3148         if {$mainlinearrow($id) ne "none"} {
3149             if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
3150                 return "up"
3151             }
3152         }
3153     }
3154     if {[info exists sidelines($id)]} {
3155         foreach ls $sidelines($id) {
3156             set coords [lindex $ls 0]
3157             set arrow [lindex $ls 2]
3158             if {$arrow eq "first" || $arrow eq "both"} {
3159                 if {abs([lindex $coords 1] - $y) < $thresh} {
3160                     return "up"
3161                 }
3162             }
3163             if {$arrow eq "last" || $arrow eq "both"} {
3164                 if {abs([lindex $coords end] - $y) < $thresh} {
3165                     return "down"
3166                 }
3167             }
3168         }
3169     }
3170     return {}
3171 }
3172
3173 proc arrowjump {id dirn y} {
3174     global mainline sidelines canv canv2 canv3
3175
3176     set yt {}
3177     if {$dirn eq "down"} {
3178         if {[info exists mainline($id)]} {
3179             set y1 [lindex $mainline($id) 1]
3180             if {$y1 > $y} {
3181                 set yt $y1
3182             }
3183         }
3184         if {[info exists sidelines($id)]} {
3185             foreach ls $sidelines($id) {
3186                 set y1 [lindex $ls 0 1]
3187                 if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
3188                     set yt $y1
3189                 }
3190             }
3191         }
3192     } else {
3193         if {[info exists sidelines($id)]} {
3194             foreach ls $sidelines($id) {
3195                 set y1 [lindex $ls 0 end]
3196                 if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
3197                     set yt $y1
3198                 }
3199             }
3200         }
3201     }
3202     if {$yt eq {}} return
3203     set ymax [lindex [$canv cget -scrollregion] 3]
3204     if {$ymax eq {} || $ymax <= 0} return
3205     set view [$canv yview]
3206     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3207     set yfrac [expr {$yt / $ymax - $yspan / 2}]
3208     if {$yfrac < 0} {
3209         set yfrac 0
3210     }
3211     $canv yview moveto $yfrac
3212     $canv2 yview moveto $yfrac
3213     $canv3 yview moveto $yfrac
3214 }
3215
3216 proc lineclick {x y id isnew} {
3217     global ctext commitinfo children cflist canv thickerline
3218
3219     unmarkmatches
3220     unselectline
3221     normalline
3222     $canv delete hover
3223     # draw this line thicker than normal
3224     drawlines $id 1 1
3225     set thickerline $id
3226     if {$isnew} {
3227         set ymax [lindex [$canv cget -scrollregion] 3]
3228         if {$ymax eq {}} return
3229         set yfrac [lindex [$canv yview] 0]
3230         set y [expr {$y + $yfrac * $ymax}]
3231     }
3232     set dirn [clickisonarrow $id $y]
3233     if {$dirn ne {}} {
3234         arrowjump $id $dirn $y
3235         return
3236     }
3237
3238     if {$isnew} {
3239         addtohistory [list lineclick $x $y $id 0]
3240     }
3241     # fill the details pane with info about this line
3242     $ctext conf -state normal
3243     $ctext delete 0.0 end
3244     $ctext tag conf link -foreground blue -underline 1
3245     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3246     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3247     $ctext insert end "Parent:\t"
3248     $ctext insert end $id [list link link0]
3249     $ctext tag bind link0 <1> [list selbyid $id]
3250     set info $commitinfo($id)
3251     $ctext insert end "\n\t[lindex $info 0]\n"
3252     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3253     set date [formatdate [lindex $info 2]]
3254     $ctext insert end "\tDate:\t$date\n"
3255     if {[info exists children($id)]} {
3256         $ctext insert end "\nChildren:"
3257         set i 0
3258         foreach child $children($id) {
3259             incr i
3260             set info $commitinfo($child)
3261             $ctext insert end "\n\t"
3262             $ctext insert end $child [list link link$i]
3263             $ctext tag bind link$i <1> [list selbyid $child]
3264             $ctext insert end "\n\t[lindex $info 0]"
3265             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3266             set date [formatdate [lindex $info 2]]
3267             $ctext insert end "\n\tDate:\t$date\n"
3268         }
3269     }
3270     $ctext conf -state disabled
3271
3272     $cflist delete 0 end
3273 }
3274
3275 proc normalline {} {
3276     global thickerline
3277     if {[info exists thickerline]} {
3278         drawlines $thickerline 0 1
3279         unset thickerline
3280     }
3281 }
3282
3283 proc selbyid {id} {
3284     global idline
3285     if {[info exists idline($id)]} {
3286         selectline $idline($id) 1
3287     }
3288 }
3289
3290 proc mstime {} {
3291     global startmstime
3292     if {![info exists startmstime]} {
3293         set startmstime [clock clicks -milliseconds]
3294     }
3295     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3296 }
3297
3298 proc rowmenu {x y id} {
3299     global rowctxmenu idline selectedline rowmenuid
3300
3301     if {![info exists selectedline] || $idline($id) eq $selectedline} {
3302         set state disabled
3303     } else {
3304         set state normal
3305     }
3306     $rowctxmenu entryconfigure 0 -state $state
3307     $rowctxmenu entryconfigure 1 -state $state
3308     $rowctxmenu entryconfigure 2 -state $state
3309     set rowmenuid $id
3310     tk_popup $rowctxmenu $x $y
3311 }
3312
3313 proc diffvssel {dirn} {
3314     global rowmenuid selectedline lineid
3315
3316     if {![info exists selectedline]} return
3317     if {$dirn} {
3318         set oldid $lineid($selectedline)
3319         set newid $rowmenuid
3320     } else {
3321         set oldid $rowmenuid
3322         set newid $lineid($selectedline)
3323     }
3324     addtohistory [list doseldiff $oldid $newid]
3325     doseldiff $oldid $newid
3326 }
3327
3328 proc doseldiff {oldid newid} {
3329     global ctext cflist
3330     global commitinfo
3331
3332     $ctext conf -state normal
3333     $ctext delete 0.0 end
3334     $ctext mark set fmark.0 0.0
3335     $ctext mark gravity fmark.0 left
3336     $cflist delete 0 end
3337     $cflist insert end "Top"
3338     $ctext insert end "From "
3339     $ctext tag conf link -foreground blue -underline 1
3340     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3341     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3342     $ctext tag bind link0 <1> [list selbyid $oldid]
3343     $ctext insert end $oldid [list link link0]
3344     $ctext insert end "\n     "
3345     $ctext insert end [lindex $commitinfo($oldid) 0]
3346     $ctext insert end "\n\nTo   "
3347     $ctext tag bind link1 <1> [list selbyid $newid]
3348     $ctext insert end $newid [list link link1]
3349     $ctext insert end "\n     "
3350     $ctext insert end [lindex $commitinfo($newid) 0]
3351     $ctext insert end "\n"
3352     $ctext conf -state disabled
3353     $ctext tag delete Comments
3354     $ctext tag remove found 1.0 end
3355     startdiff [list $newid $oldid] 0
3356 }
3357
3358 proc mkpatch {} {
3359     global rowmenuid currentid commitinfo patchtop patchnum
3360
3361     if {![info exists currentid]} return
3362     set oldid $currentid
3363     set oldhead [lindex $commitinfo($oldid) 0]
3364     set newid $rowmenuid
3365     set newhead [lindex $commitinfo($newid) 0]
3366     set top .patch
3367     set patchtop $top
3368     catch {destroy $top}
3369     toplevel $top
3370     label $top.title -text "Generate patch"
3371     grid $top.title - -pady 10
3372     label $top.from -text "From:"
3373     entry $top.fromsha1 -width 40 -relief flat
3374     $top.fromsha1 insert 0 $oldid
3375     $top.fromsha1 conf -state readonly
3376     grid $top.from $top.fromsha1 -sticky w
3377     entry $top.fromhead -width 60 -relief flat
3378     $top.fromhead insert 0 $oldhead
3379     $top.fromhead conf -state readonly
3380     grid x $top.fromhead -sticky w
3381     label $top.to -text "To:"
3382     entry $top.tosha1 -width 40 -relief flat
3383     $top.tosha1 insert 0 $newid
3384     $top.tosha1 conf -state readonly
3385     grid $top.to $top.tosha1 -sticky w
3386     entry $top.tohead -width 60 -relief flat
3387     $top.tohead insert 0 $newhead
3388     $top.tohead conf -state readonly
3389     grid x $top.tohead -sticky w
3390     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3391     grid $top.rev x -pady 10
3392     label $top.flab -text "Output file:"
3393     entry $top.fname -width 60
3394     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3395     incr patchnum
3396     grid $top.flab $top.fname -sticky w
3397     frame $top.buts
3398     button $top.buts.gen -text "Generate" -command mkpatchgo
3399     button $top.buts.can -text "Cancel" -command mkpatchcan
3400     grid $top.buts.gen $top.buts.can
3401     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3402     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3403     grid $top.buts - -pady 10 -sticky ew
3404     focus $top.fname
3405 }
3406
3407 proc mkpatchrev {} {
3408     global patchtop
3409
3410     set oldid [$patchtop.fromsha1 get]
3411     set oldhead [$patchtop.fromhead get]
3412     set newid [$patchtop.tosha1 get]
3413     set newhead [$patchtop.tohead get]
3414     foreach e [list fromsha1 fromhead tosha1 tohead] \
3415             v [list $newid $newhead $oldid $oldhead] {
3416         $patchtop.$e conf -state normal
3417         $patchtop.$e delete 0 end
3418         $patchtop.$e insert 0 $v
3419         $patchtop.$e conf -state readonly
3420     }
3421 }
3422
3423 proc mkpatchgo {} {
3424     global patchtop
3425
3426     set oldid [$patchtop.fromsha1 get]
3427     set newid [$patchtop.tosha1 get]
3428     set fname [$patchtop.fname get]
3429     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3430         error_popup "Error creating patch: $err"
3431     }
3432     catch {destroy $patchtop}
3433     unset patchtop
3434 }
3435
3436 proc mkpatchcan {} {
3437     global patchtop
3438
3439     catch {destroy $patchtop}
3440     unset patchtop
3441 }
3442
3443 proc mktag {} {
3444     global rowmenuid mktagtop commitinfo
3445
3446     set top .maketag
3447     set mktagtop $top
3448     catch {destroy $top}
3449     toplevel $top
3450     label $top.title -text "Create tag"
3451     grid $top.title - -pady 10
3452     label $top.id -text "ID:"
3453     entry $top.sha1 -width 40 -relief flat
3454     $top.sha1 insert 0 $rowmenuid
3455     $top.sha1 conf -state readonly
3456     grid $top.id $top.sha1 -sticky w
3457     entry $top.head -width 60 -relief flat
3458     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3459     $top.head conf -state readonly
3460     grid x $top.head -sticky w
3461     label $top.tlab -text "Tag name:"
3462     entry $top.tag -width 60
3463     grid $top.tlab $top.tag -sticky w
3464     frame $top.buts
3465     button $top.buts.gen -text "Create" -command mktaggo
3466     button $top.buts.can -text "Cancel" -command mktagcan
3467     grid $top.buts.gen $top.buts.can
3468     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3469     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3470     grid $top.buts - -pady 10 -sticky ew
3471     focus $top.tag
3472 }
3473
3474 proc domktag {} {
3475     global mktagtop env tagids idtags
3476
3477     set id [$mktagtop.sha1 get]
3478     set tag [$mktagtop.tag get]
3479     if {$tag == {}} {
3480         error_popup "No tag name specified"
3481         return
3482     }
3483     if {[info exists tagids($tag)]} {
3484         error_popup "Tag \"$tag\" already exists"
3485         return
3486     }
3487     if {[catch {
3488         set dir [gitdir]
3489         set fname [file join $dir "refs/tags" $tag]
3490         set f [open $fname w]
3491         puts $f $id
3492         close $f
3493     } err]} {
3494         error_popup "Error creating tag: $err"
3495         return
3496     }
3497
3498     set tagids($tag) $id
3499     lappend idtags($id) $tag
3500     redrawtags $id
3501 }
3502
3503 proc redrawtags {id} {
3504     global canv linehtag idline idpos selectedline
3505
3506     if {![info exists idline($id)]} return
3507     $canv delete tag.$id
3508     set xt [eval drawtags $id $idpos($id)]
3509     $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3510     if {[info exists selectedline] && $selectedline == $idline($id)} {
3511         selectline $selectedline 0
3512     }
3513 }
3514
3515 proc mktagcan {} {
3516     global mktagtop
3517
3518     catch {destroy $mktagtop}
3519     unset mktagtop
3520 }
3521
3522 proc mktaggo {} {
3523     domktag
3524     mktagcan
3525 }
3526
3527 proc writecommit {} {
3528     global rowmenuid wrcomtop commitinfo wrcomcmd
3529
3530     set top .writecommit
3531     set wrcomtop $top
3532     catch {destroy $top}
3533     toplevel $top
3534     label $top.title -text "Write commit to file"
3535     grid $top.title - -pady 10
3536     label $top.id -text "ID:"
3537     entry $top.sha1 -width 40 -relief flat
3538     $top.sha1 insert 0 $rowmenuid
3539     $top.sha1 conf -state readonly
3540     grid $top.id $top.sha1 -sticky w
3541     entry $top.head -width 60 -relief flat
3542     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3543     $top.head conf -state readonly
3544     grid x $top.head -sticky w
3545     label $top.clab -text "Command:"
3546     entry $top.cmd -width 60 -textvariable wrcomcmd
3547     grid $top.clab $top.cmd -sticky w -pady 10
3548     label $top.flab -text "Output file:"
3549     entry $top.fname -width 60
3550     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3551     grid $top.flab $top.fname -sticky w
3552     frame $top.buts
3553     button $top.buts.gen -text "Write" -command wrcomgo
3554     button $top.buts.can -text "Cancel" -command wrcomcan
3555     grid $top.buts.gen $top.buts.can
3556     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3557     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3558     grid $top.buts - -pady 10 -sticky ew
3559     focus $top.fname
3560 }
3561
3562 proc wrcomgo {} {
3563     global wrcomtop
3564
3565     set id [$wrcomtop.sha1 get]
3566     set cmd "echo $id | [$wrcomtop.cmd get]"
3567     set fname [$wrcomtop.fname get]
3568     if {[catch {exec sh -c $cmd >$fname &} err]} {
3569         error_popup "Error writing commit: $err"
3570     }
3571     catch {destroy $wrcomtop}
3572     unset wrcomtop
3573 }
3574
3575 proc wrcomcan {} {
3576     global wrcomtop
3577
3578     catch {destroy $wrcomtop}
3579     unset wrcomtop
3580 }
3581
3582 proc listrefs {id} {
3583     global idtags idheads idotherrefs
3584
3585     set x {}
3586     if {[info exists idtags($id)]} {
3587         set x $idtags($id)
3588     }
3589     set y {}
3590     if {[info exists idheads($id)]} {
3591         set y $idheads($id)
3592     }
3593     set z {}
3594     if {[info exists idotherrefs($id)]} {
3595         set z $idotherrefs($id)
3596     }
3597     return [list $x $y $z]
3598 }
3599
3600 proc rereadrefs {} {
3601     global idtags idheads idotherrefs
3602     global tagids headids otherrefids
3603
3604     set refids [concat [array names idtags] \
3605                     [array names idheads] [array names idotherrefs]]
3606     foreach id $refids {
3607         if {![info exists ref($id)]} {
3608             set ref($id) [listrefs $id]
3609         }
3610     }
3611     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
3612         catch {unset $v}
3613     }
3614     readrefs
3615     set refids [lsort -unique [concat $refids [array names idtags] \
3616                         [array names idheads] [array names idotherrefs]]]
3617     foreach id $refids {
3618         set v [listrefs $id]
3619         if {![info exists ref($id)] || $ref($id) != $v} {
3620             redrawtags $id
3621         }
3622     }
3623 }
3624
3625 proc showtag {tag isnew} {
3626     global ctext cflist tagcontents tagids linknum
3627
3628     if {$isnew} {
3629         addtohistory [list showtag $tag 0]
3630     }
3631     $ctext conf -state normal
3632     $ctext delete 0.0 end
3633     set linknum 0
3634     if {[info exists tagcontents($tag)]} {
3635         set text $tagcontents($tag)
3636     } else {
3637         set text "Tag: $tag\nId:  $tagids($tag)"
3638     }
3639     appendwithlinks $text
3640     $ctext conf -state disabled
3641     $cflist delete 0 end
3642 }
3643
3644 proc doquit {} {
3645     global stopped
3646     set stopped 100
3647     destroy .
3648 }
3649
3650 proc formatdate {d} {
3651     global hours nhours tfd fastdate
3652
3653     if {!$fastdate} {
3654         return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3655     }
3656     set hr [expr {$d / 3600}]
3657     set ms [expr {$d % 3600}]
3658     if {![info exists hours($hr)]} {
3659         set hours($hr) [clock format $d -format "%Y-%m-%d %H"]
3660         set nhours($hr) 0
3661     }
3662     incr nhours($hr)
3663     set minsec [format "%.2d:%.2d" [expr {$ms/60}] [expr {$ms%60}]]
3664     return "$hours($hr):$minsec"
3665 }
3666
3667 # defaults...
3668 set datemode 0
3669 set boldnames 0
3670 set diffopts "-U 5 -p"
3671 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3672 set gitencoding "utf-8"
3673
3674 set mainfont {Helvetica 9}
3675 set textfont {Courier 9}
3676 set findmergefiles 0
3677 set gaudydiff 0
3678 set maxgraphpct 50
3679 set maxwidth 16
3680 set revlistorder 0
3681 set fastdate 0
3682
3683 set colors {green red blue magenta darkgrey brown orange}
3684
3685 catch {source ~/.gitk}
3686
3687 set namefont $mainfont
3688 if {$boldnames} {
3689     lappend namefont bold
3690 }
3691
3692 set revtreeargs {}
3693 foreach arg $argv {
3694     switch -regexp -- $arg {
3695         "^$" { }
3696         "^-b" { set boldnames 1 }
3697         "^-d" { set datemode 1 }
3698         "^-r" { set revlistorder 1 }
3699         default {
3700             lappend revtreeargs $arg
3701         }
3702     }
3703 }
3704
3705 set history {}
3706 set historyindex 0
3707
3708 set stopped 0
3709 set redisplaying 0
3710 set stuffsaved 0
3711 set patchnum 0
3712 setcoords
3713 makewindow
3714 readrefs
3715 getcommits $revtreeargs