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 $id
2169     } elseif {$nparents($id) > 1} {
2170         mergediff $id
2171     }
2172 }
2173
2174 proc selnextline {dir} {
2175     global selectedline
2176     if {![info exists selectedline]} return
2177     set l [expr {$selectedline + $dir}]
2178     unmarkmatches
2179     selectline $l 1
2180 }
2181
2182 proc unselectline {} {
2183     global selectedline
2184
2185     catch {unset selectedline}
2186     allcanvs delete secsel
2187 }
2188
2189 proc addtohistory {cmd} {
2190     global history historyindex
2191
2192     if {$historyindex > 0
2193         && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2194         return
2195     }
2196
2197     if {$historyindex < [llength $history]} {
2198         set history [lreplace $history $historyindex end $cmd]
2199     } else {
2200         lappend history $cmd
2201     }
2202     incr historyindex
2203     if {$historyindex > 1} {
2204         .ctop.top.bar.leftbut conf -state normal
2205     } else {
2206         .ctop.top.bar.leftbut conf -state disabled
2207     }
2208     .ctop.top.bar.rightbut conf -state disabled
2209 }
2210
2211 proc goback {} {
2212     global history historyindex
2213
2214     if {$historyindex > 1} {
2215         incr historyindex -1
2216         set cmd [lindex $history [expr {$historyindex - 1}]]
2217         eval $cmd
2218         .ctop.top.bar.rightbut conf -state normal
2219     }
2220     if {$historyindex <= 1} {
2221         .ctop.top.bar.leftbut conf -state disabled
2222     }
2223 }
2224
2225 proc goforw {} {
2226     global history historyindex
2227
2228     if {$historyindex < [llength $history]} {
2229         set cmd [lindex $history $historyindex]
2230         incr historyindex
2231         eval $cmd
2232         .ctop.top.bar.leftbut conf -state normal
2233     }
2234     if {$historyindex >= [llength $history]} {
2235         .ctop.top.bar.rightbut conf -state disabled
2236     }
2237 }
2238
2239 proc mergediff {id} {
2240     global parents diffmergeid diffmergegca mergefilelist diffpindex
2241
2242     set diffmergeid $id
2243     set diffpindex -1
2244     set diffmergegca [findgca $parents($id)]
2245     if {[info exists mergefilelist($id)]} {
2246         if {$mergefilelist($id) ne {}} {
2247             showmergediff
2248         }
2249     } else {
2250         contmergediff {}
2251     }
2252 }
2253
2254 proc findgca {ids} {
2255     set gca {}
2256     foreach id $ids {
2257         if {$gca eq {}} {
2258             set gca $id
2259         } else {
2260             if {[catch {
2261                 set gca [exec git-merge-base $gca $id]
2262             } err]} {
2263                 return {}
2264             }
2265         }
2266     }
2267     return $gca
2268 }
2269
2270 proc contmergediff {ids} {
2271     global diffmergeid diffpindex parents nparents diffmergegca
2272     global treediffs mergefilelist diffids treepending
2273
2274     # diff the child against each of the parents, and diff
2275     # each of the parents against the GCA.
2276     while 1 {
2277         if {[lindex $ids 1] == $diffmergeid && $diffmergegca ne {}} {
2278             set ids [list $diffmergegca [lindex $ids 0]]
2279         } else {
2280             if {[incr diffpindex] >= $nparents($diffmergeid)} break
2281             set p [lindex $parents($diffmergeid) $diffpindex]
2282             set ids [list $p $diffmergeid]
2283         }
2284         if {![info exists treediffs($ids)]} {
2285             set diffids $ids
2286             if {![info exists treepending]} {
2287                 gettreediffs $ids
2288             }
2289             return
2290         }
2291     }
2292
2293     # If a file in some parent is different from the child and also
2294     # different from the GCA, then it's interesting.
2295     # If we don't have a GCA, then a file is interesting if it is
2296     # different from the child in all the parents.
2297     if {$diffmergegca ne {}} {
2298         set files {}
2299         foreach p $parents($diffmergeid) {
2300             set gcadiffs $treediffs([list $diffmergegca $p])
2301             foreach f $treediffs([list $p $diffmergeid]) {
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 $p $diffmergeid])
2315             set nf {}
2316             foreach f $files {
2317                 if {[lsearch -exact $df $f] >= 0} {
2318                     lappend nf $f
2319                 }
2320             }
2321             set files $nf
2322         }
2323     }
2324
2325     set mergefilelist($diffmergeid) $files
2326     if {$files ne {}} {
2327         showmergediff
2328     }
2329 }
2330
2331 proc showmergediff {} {
2332     global cflist diffmergeid mergefilelist parents
2333     global diffopts diffinhunk currentfile currenthunk filelines
2334     global diffblocked groupfilelast mergefds groupfilenum grouphunks
2335
2336     set files $mergefilelist($diffmergeid)
2337     foreach f $files {
2338         $cflist insert end $f
2339     }
2340     set env(GIT_DIFF_OPTS) $diffopts
2341     set flist {}
2342     catch {unset currentfile}
2343     catch {unset currenthunk}
2344     catch {unset filelines}
2345     catch {unset groupfilenum}
2346     catch {unset grouphunks}
2347     set groupfilelast -1
2348     foreach p $parents($diffmergeid) {
2349         set cmd [list | git-diff-tree -p $p $diffmergeid]
2350         set cmd [concat $cmd $mergefilelist($diffmergeid)]
2351         if {[catch {set f [open $cmd r]} err]} {
2352             error_popup "Error getting diffs: $err"
2353             foreach f $flist {
2354                 catch {close $f}
2355             }
2356             return
2357         }
2358         lappend flist $f
2359         set ids [list $diffmergeid $p]
2360         set mergefds($ids) $f
2361         set diffinhunk($ids) 0
2362         set diffblocked($ids) 0
2363         fconfigure $f -blocking 0
2364         fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
2365     }
2366 }
2367
2368 proc getmergediffline {f ids id} {
2369     global diffmergeid diffinhunk diffoldlines diffnewlines
2370     global currentfile currenthunk
2371     global diffoldstart diffnewstart diffoldlno diffnewlno
2372     global diffblocked mergefilelist
2373     global noldlines nnewlines difflcounts filelines
2374
2375     set n [gets $f line]
2376     if {$n < 0} {
2377         if {![eof $f]} return
2378     }
2379
2380     if {!([info exists diffmergeid] && $diffmergeid == $id)} {
2381         if {$n < 0} {
2382             close $f
2383         }
2384         return
2385     }
2386
2387     if {$diffinhunk($ids) != 0} {
2388         set fi $currentfile($ids)
2389         if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
2390             # continuing an existing hunk
2391             set line [string range $line 1 end]
2392             set p [lindex $ids 1]
2393             if {$match eq "-" || $match eq " "} {
2394                 set filelines($p,$fi,$diffoldlno($ids)) $line
2395                 incr diffoldlno($ids)
2396             }
2397             if {$match eq "+" || $match eq " "} {
2398                 set filelines($id,$fi,$diffnewlno($ids)) $line
2399                 incr diffnewlno($ids)
2400             }
2401             if {$match eq " "} {
2402                 if {$diffinhunk($ids) == 2} {
2403                     lappend difflcounts($ids) \
2404                         [list $noldlines($ids) $nnewlines($ids)]
2405                     set noldlines($ids) 0
2406                     set diffinhunk($ids) 1
2407                 }
2408                 incr noldlines($ids)
2409             } elseif {$match eq "-" || $match eq "+"} {
2410                 if {$diffinhunk($ids) == 1} {
2411                     lappend difflcounts($ids) [list $noldlines($ids)]
2412                     set noldlines($ids) 0
2413                     set nnewlines($ids) 0
2414                     set diffinhunk($ids) 2
2415                 }
2416                 if {$match eq "-"} {
2417                     incr noldlines($ids)
2418                 } else {
2419                     incr nnewlines($ids)
2420                 }
2421             }
2422             # and if it's \ No newline at end of line, then what?
2423             return
2424         }
2425         # end of a hunk
2426         if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
2427             lappend difflcounts($ids) [list $noldlines($ids)]
2428         } elseif {$diffinhunk($ids) == 2
2429                   && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
2430             lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
2431         }
2432         set currenthunk($ids) [list $currentfile($ids) \
2433                                    $diffoldstart($ids) $diffnewstart($ids) \
2434                                    $diffoldlno($ids) $diffnewlno($ids) \
2435                                    $difflcounts($ids)]
2436         set diffinhunk($ids) 0
2437         # -1 = need to block, 0 = unblocked, 1 = is blocked
2438         set diffblocked($ids) -1
2439         processhunks
2440         if {$diffblocked($ids) == -1} {
2441             fileevent $f readable {}
2442             set diffblocked($ids) 1
2443         }
2444     }
2445
2446     if {$n < 0} {
2447         # eof
2448         if {!$diffblocked($ids)} {
2449             close $f
2450             set currentfile($ids) [llength $mergefilelist($diffmergeid)]
2451             set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
2452             processhunks
2453         }
2454     } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
2455         # start of a new file
2456         set currentfile($ids) \
2457             [lsearch -exact $mergefilelist($diffmergeid) $fname]
2458     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2459                    $line match f1l f1c f2l f2c rest]} {
2460         if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
2461             # start of a new hunk
2462             if {$f1l == 0 && $f1c == 0} {
2463                 set f1l 1
2464             }
2465             if {$f2l == 0 && $f2c == 0} {
2466                 set f2l 1
2467             }
2468             set diffinhunk($ids) 1
2469             set diffoldstart($ids) $f1l
2470             set diffnewstart($ids) $f2l
2471             set diffoldlno($ids) $f1l
2472             set diffnewlno($ids) $f2l
2473             set difflcounts($ids) {}
2474             set noldlines($ids) 0
2475             set nnewlines($ids) 0
2476         }
2477     }
2478 }
2479
2480 proc processhunks {} {
2481     global diffmergeid parents nparents currenthunk
2482     global mergefilelist diffblocked mergefds
2483     global grouphunks grouplinestart grouplineend groupfilenum
2484
2485     set nfiles [llength $mergefilelist($diffmergeid)]
2486     while 1 {
2487         set fi $nfiles
2488         set lno 0
2489         # look for the earliest hunk
2490         foreach p $parents($diffmergeid) {
2491             set ids [list $diffmergeid $p]
2492             if {![info exists currenthunk($ids)]} return
2493             set i [lindex $currenthunk($ids) 0]
2494             set l [lindex $currenthunk($ids) 2]
2495             if {$i < $fi || ($i == $fi && $l < $lno)} {
2496                 set fi $i
2497                 set lno $l
2498                 set pi $p
2499             }
2500         }
2501
2502         if {$fi < $nfiles} {
2503             set ids [list $diffmergeid $pi]
2504             set hunk $currenthunk($ids)
2505             unset currenthunk($ids)
2506             if {$diffblocked($ids) > 0} {
2507                 fileevent $mergefds($ids) readable \
2508                     [list getmergediffline $mergefds($ids) $ids $diffmergeid]
2509             }
2510             set diffblocked($ids) 0
2511
2512             if {[info exists groupfilenum] && $groupfilenum == $fi
2513                 && $lno <= $grouplineend} {
2514                 # add this hunk to the pending group
2515                 lappend grouphunks($pi) $hunk
2516                 set endln [lindex $hunk 4]
2517                 if {$endln > $grouplineend} {
2518                     set grouplineend $endln
2519                 }
2520                 continue
2521             }
2522         }
2523
2524         # succeeding stuff doesn't belong in this group, so
2525         # process the group now
2526         if {[info exists groupfilenum]} {
2527             processgroup
2528             unset groupfilenum
2529             unset grouphunks
2530         }
2531
2532         if {$fi >= $nfiles} break
2533
2534         # start a new group
2535         set groupfilenum $fi
2536         set grouphunks($pi) [list $hunk]
2537         set grouplinestart $lno
2538         set grouplineend [lindex $hunk 4]
2539     }
2540 }
2541
2542 proc processgroup {} {
2543     global groupfilelast groupfilenum difffilestart
2544     global mergefilelist diffmergeid ctext filelines
2545     global parents diffmergeid diffoffset
2546     global grouphunks grouplinestart grouplineend nparents
2547     global mergemax
2548
2549     $ctext conf -state normal
2550     set id $diffmergeid
2551     set f $groupfilenum
2552     if {$groupfilelast != $f} {
2553         $ctext insert end "\n"
2554         set here [$ctext index "end - 1c"]
2555         set difffilestart($f) $here
2556         set mark fmark.[expr {$f + 1}]
2557         $ctext mark set $mark $here
2558         $ctext mark gravity $mark left
2559         set header [lindex $mergefilelist($id) $f]
2560         set l [expr {(78 - [string length $header]) / 2}]
2561         set pad [string range "----------------------------------------" 1 $l]
2562         $ctext insert end "$pad $header $pad\n" filesep
2563         set groupfilelast $f
2564         foreach p $parents($id) {
2565             set diffoffset($p) 0
2566         }
2567     }
2568
2569     $ctext insert end "@@" msep
2570     set nlines [expr {$grouplineend - $grouplinestart}]
2571     set events {}
2572     set pnum 0
2573     foreach p $parents($id) {
2574         set startline [expr {$grouplinestart + $diffoffset($p)}]
2575         set ol $startline
2576         set nl $grouplinestart
2577         if {[info exists grouphunks($p)]} {
2578             foreach h $grouphunks($p) {
2579                 set l [lindex $h 2]
2580                 if {$nl < $l} {
2581                     for {} {$nl < $l} {incr nl} {
2582                         set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2583                         incr ol
2584                     }
2585                 }
2586                 foreach chunk [lindex $h 5] {
2587                     if {[llength $chunk] == 2} {
2588                         set olc [lindex $chunk 0]
2589                         set nlc [lindex $chunk 1]
2590                         set nnl [expr {$nl + $nlc}]
2591                         lappend events [list $nl $nnl $pnum $olc $nlc]
2592                         incr ol $olc
2593                         set nl $nnl
2594                     } else {
2595                         incr ol [lindex $chunk 0]
2596                         incr nl [lindex $chunk 0]
2597                     }
2598                 }
2599             }
2600         }
2601         if {$nl < $grouplineend} {
2602             for {} {$nl < $grouplineend} {incr nl} {
2603                 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2604                 incr ol
2605             }
2606         }
2607         set nlines [expr {$ol - $startline}]
2608         $ctext insert end " -$startline,$nlines" msep
2609         incr pnum
2610     }
2611
2612     set nlines [expr {$grouplineend - $grouplinestart}]
2613     $ctext insert end " +$grouplinestart,$nlines @@\n" msep
2614
2615     set events [lsort -integer -index 0 $events]
2616     set nevents [llength $events]
2617     set nmerge $nparents($diffmergeid)
2618     set l $grouplinestart
2619     for {set i 0} {$i < $nevents} {set i $j} {
2620         set nl [lindex $events $i 0]
2621         while {$l < $nl} {
2622             $ctext insert end " $filelines($id,$f,$l)\n"
2623             incr l
2624         }
2625         set e [lindex $events $i]
2626         set enl [lindex $e 1]
2627         set j $i
2628         set active {}
2629         while 1 {
2630             set pnum [lindex $e 2]
2631             set olc [lindex $e 3]
2632             set nlc [lindex $e 4]
2633             if {![info exists delta($pnum)]} {
2634                 set delta($pnum) [expr {$olc - $nlc}]
2635                 lappend active $pnum
2636             } else {
2637                 incr delta($pnum) [expr {$olc - $nlc}]
2638             }
2639             if {[incr j] >= $nevents} break
2640             set e [lindex $events $j]
2641             if {[lindex $e 0] >= $enl} break
2642             if {[lindex $e 1] > $enl} {
2643                 set enl [lindex $e 1]
2644             }
2645         }
2646         set nlc [expr {$enl - $l}]
2647         set ncol mresult
2648         set bestpn -1
2649         if {[llength $active] == $nmerge - 1} {
2650             # no diff for one of the parents, i.e. it's identical
2651             for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2652                 if {![info exists delta($pnum)]} {
2653                     if {$pnum < $mergemax} {
2654                         lappend ncol m$pnum
2655                     } else {
2656                         lappend ncol mmax
2657                     }
2658                     break
2659                 }
2660             }
2661         } elseif {[llength $active] == $nmerge} {
2662             # all parents are different, see if one is very similar
2663             set bestsim 30
2664             for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2665                 set sim [similarity $pnum $l $nlc $f \
2666                              [lrange $events $i [expr {$j-1}]]]
2667                 if {$sim > $bestsim} {
2668                     set bestsim $sim
2669                     set bestpn $pnum
2670                 }
2671             }
2672             if {$bestpn >= 0} {
2673                 lappend ncol m$bestpn
2674             }
2675         }
2676         set pnum -1
2677         foreach p $parents($id) {
2678             incr pnum
2679             if {![info exists delta($pnum)] || $pnum == $bestpn} continue
2680             set olc [expr {$nlc + $delta($pnum)}]
2681             set ol [expr {$l + $diffoffset($p)}]
2682             incr diffoffset($p) $delta($pnum)
2683             unset delta($pnum)
2684             for {} {$olc > 0} {incr olc -1} {
2685                 $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
2686                 incr ol
2687             }
2688         }
2689         set endl [expr {$l + $nlc}]
2690         if {$bestpn >= 0} {
2691             # show this pretty much as a normal diff
2692             set p [lindex $parents($id) $bestpn]
2693             set ol [expr {$l + $diffoffset($p)}]
2694             incr diffoffset($p) $delta($bestpn)
2695             unset delta($bestpn)
2696             for {set k $i} {$k < $j} {incr k} {
2697                 set e [lindex $events $k]
2698                 if {[lindex $e 2] != $bestpn} continue
2699                 set nl [lindex $e 0]
2700                 set ol [expr {$ol + $nl - $l}]
2701                 for {} {$l < $nl} {incr l} {
2702                     $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2703                 }
2704                 set c [lindex $e 3]
2705                 for {} {$c > 0} {incr c -1} {
2706                     $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn
2707                     incr ol
2708                 }
2709                 set nl [lindex $e 1]
2710                 for {} {$l < $nl} {incr l} {
2711                     $ctext insert end "+$filelines($id,$f,$l)\n" mresult
2712                 }
2713             }
2714         }
2715         for {} {$l < $endl} {incr l} {
2716             $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2717         }
2718     }
2719     while {$l < $grouplineend} {
2720         $ctext insert end " $filelines($id,$f,$l)\n"
2721         incr l
2722     }
2723     $ctext conf -state disabled
2724 }
2725
2726 proc similarity {pnum l nlc f events} {
2727     global diffmergeid parents diffoffset filelines
2728
2729     set id $diffmergeid
2730     set p [lindex $parents($id) $pnum]
2731     set ol [expr {$l + $diffoffset($p)}]
2732     set endl [expr {$l + $nlc}]
2733     set same 0
2734     set diff 0
2735     foreach e $events {
2736         if {[lindex $e 2] != $pnum} continue
2737         set nl [lindex $e 0]
2738         set ol [expr {$ol + $nl - $l}]
2739         for {} {$l < $nl} {incr l} {
2740             incr same [string length $filelines($id,$f,$l)]
2741             incr same
2742         }
2743         set oc [lindex $e 3]
2744         for {} {$oc > 0} {incr oc -1} {
2745             incr diff [string length $filelines($p,$f,$ol)]
2746             incr diff
2747             incr ol
2748         }
2749         set nl [lindex $e 1]
2750         for {} {$l < $nl} {incr l} {
2751             incr diff [string length $filelines($id,$f,$l)]
2752             incr diff
2753         }
2754     }
2755     for {} {$l < $endl} {incr l} {
2756         incr same [string length $filelines($id,$f,$l)]
2757         incr same
2758     }
2759     if {$same == 0} {
2760         return 0
2761     }
2762     return [expr {200 * $same / (2 * $same + $diff)}]
2763 }
2764
2765 proc startdiff {ids} {
2766     global treediffs diffids treepending diffmergeid
2767
2768     set diffids $ids
2769     catch {unset diffmergeid}
2770     if {![info exists treediffs($ids)]} {
2771         if {![info exists treepending]} {
2772             gettreediffs $ids
2773         }
2774     } else {
2775         addtocflist $ids
2776     }
2777 }
2778
2779 proc addtocflist {ids} {
2780     global treediffs cflist
2781     foreach f $treediffs($ids) {
2782         $cflist insert end $f
2783     }
2784     getblobdiffs $ids
2785 }
2786
2787 proc gettreediffs {ids} {
2788     global treediff parents treepending
2789     set treepending $ids
2790     set treediff {}
2791     if [catch {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]}] return
2792     fconfigure $gdtf -blocking 0
2793     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2794 }
2795
2796 proc gettreediffline {gdtf ids} {
2797     global treediff treediffs treepending diffids diffmergeid
2798
2799     set n [gets $gdtf line]
2800     if {$n < 0} {
2801         if {![eof $gdtf]} return
2802         close $gdtf
2803         set treediffs($ids) $treediff
2804         unset treepending
2805         if {$ids != $diffids} {
2806             gettreediffs $diffids
2807         } else {
2808             if {[info exists diffmergeid]} {
2809                 contmergediff $ids
2810             } else {
2811                 addtocflist $ids
2812             }
2813         }
2814         return
2815     }
2816     set file [lindex $line 5]
2817     lappend treediff $file
2818 }
2819
2820 proc getblobdiffs {ids} {
2821     global diffopts blobdifffd diffids env curdifftag curtagstart
2822     global difffilestart nextupdate diffinhdr treediffs
2823
2824     set env(GIT_DIFF_OPTS) $diffopts
2825     set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2826     if {[catch {set bdf [open $cmd r]} err]} {
2827         puts "error getting diffs: $err"
2828         return
2829     }
2830     set diffinhdr 0
2831     fconfigure $bdf -blocking 0
2832     set blobdifffd($ids) $bdf
2833     set curdifftag Comments
2834     set curtagstart 0.0
2835     catch {unset difffilestart}
2836     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2837     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2838 }
2839
2840 proc getblobdiffline {bdf ids} {
2841     global diffids blobdifffd ctext curdifftag curtagstart
2842     global diffnexthead diffnextnote difffilestart
2843     global nextupdate diffinhdr treediffs
2844     global gaudydiff
2845
2846     set n [gets $bdf line]
2847     if {$n < 0} {
2848         if {[eof $bdf]} {
2849             close $bdf
2850             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2851                 $ctext tag add $curdifftag $curtagstart end
2852             }
2853         }
2854         return
2855     }
2856     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2857         return
2858     }
2859     $ctext conf -state normal
2860     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2861         # start of a new file
2862         $ctext insert end "\n"
2863         $ctext tag add $curdifftag $curtagstart end
2864         set curtagstart [$ctext index "end - 1c"]
2865         set header $newname
2866         set here [$ctext index "end - 1c"]
2867         set i [lsearch -exact $treediffs($diffids) $fname]
2868         if {$i >= 0} {
2869             set difffilestart($i) $here
2870             incr i
2871             $ctext mark set fmark.$i $here
2872             $ctext mark gravity fmark.$i left
2873         }
2874         if {$newname != $fname} {
2875             set i [lsearch -exact $treediffs($diffids) $newname]
2876             if {$i >= 0} {
2877                 set difffilestart($i) $here
2878                 incr i
2879                 $ctext mark set fmark.$i $here
2880                 $ctext mark gravity fmark.$i left
2881             }
2882         }
2883         set curdifftag "f:$fname"
2884         $ctext tag delete $curdifftag
2885         set l [expr {(78 - [string length $header]) / 2}]
2886         set pad [string range "----------------------------------------" 1 $l]
2887         $ctext insert end "$pad $header $pad\n" filesep
2888         set diffinhdr 1
2889     } elseif {[regexp {^(---|\+\+\+)} $line]} {
2890         set diffinhdr 0
2891     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2892                    $line match f1l f1c f2l f2c rest]} {
2893         if {$gaudydiff} {
2894             $ctext insert end "\t" hunksep
2895             $ctext insert end "    $f1l    " d0 "    $f2l    " d1
2896             $ctext insert end "    $rest \n" hunksep
2897         } else {
2898             $ctext insert end "$line\n" hunksep
2899         }
2900         set diffinhdr 0
2901     } else {
2902         set x [string range $line 0 0]
2903         if {$x == "-" || $x == "+"} {
2904             set tag [expr {$x == "+"}]
2905             if {$gaudydiff} {
2906                 set line [string range $line 1 end]
2907             }
2908             $ctext insert end "$line\n" d$tag
2909         } elseif {$x == " "} {
2910             if {$gaudydiff} {
2911                 set line [string range $line 1 end]
2912             }
2913             $ctext insert end "$line\n"
2914         } elseif {$diffinhdr || $x == "\\"} {
2915             # e.g. "\ No newline at end of file"
2916             $ctext insert end "$line\n" filesep
2917         } else {
2918             # Something else we don't recognize
2919             if {$curdifftag != "Comments"} {
2920                 $ctext insert end "\n"
2921                 $ctext tag add $curdifftag $curtagstart end
2922                 set curtagstart [$ctext index "end - 1c"]
2923                 set curdifftag Comments
2924             }
2925             $ctext insert end "$line\n" filesep
2926         }
2927     }
2928     $ctext conf -state disabled
2929     if {[clock clicks -milliseconds] >= $nextupdate} {
2930         incr nextupdate 100
2931         fileevent $bdf readable {}
2932         update
2933         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2934     }
2935 }
2936
2937 proc nextfile {} {
2938     global difffilestart ctext
2939     set here [$ctext index @0,0]
2940     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2941         if {[$ctext compare $difffilestart($i) > $here]} {
2942             if {![info exists pos]
2943                 || [$ctext compare $difffilestart($i) < $pos]} {
2944                 set pos $difffilestart($i)
2945             }
2946         }
2947     }
2948     if {[info exists pos]} {
2949         $ctext yview $pos
2950     }
2951 }
2952
2953 proc listboxsel {} {
2954     global ctext cflist currentid
2955     if {![info exists currentid]} return
2956     set sel [lsort [$cflist curselection]]
2957     if {$sel eq {}} return
2958     set first [lindex $sel 0]
2959     catch {$ctext yview fmark.$first}
2960 }
2961
2962 proc setcoords {} {
2963     global linespc charspc canvx0 canvy0 mainfont
2964     global xspc1 xspc2 lthickness
2965
2966     set linespc [font metrics $mainfont -linespace]
2967     set charspc [font measure $mainfont "m"]
2968     set canvy0 [expr {3 + 0.5 * $linespc}]
2969     set canvx0 [expr {3 + 0.5 * $linespc}]
2970     set lthickness [expr {int($linespc / 9) + 1}]
2971     set xspc1(0) $linespc
2972     set xspc2 $linespc
2973 }
2974
2975 proc redisplay {} {
2976     global stopped redisplaying phase
2977     if {$stopped > 1} return
2978     if {$phase == "getcommits"} return
2979     set redisplaying 1
2980     if {$phase == "drawgraph" || $phase == "incrdraw"} {
2981         set stopped 1
2982     } else {
2983         drawgraph
2984     }
2985 }
2986
2987 proc incrfont {inc} {
2988     global mainfont namefont textfont ctext canv phase
2989     global stopped entries
2990     unmarkmatches
2991     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2992     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2993     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2994     setcoords
2995     $ctext conf -font $textfont
2996     $ctext tag conf filesep -font [concat $textfont bold]
2997     foreach e $entries {
2998         $e conf -font $mainfont
2999     }
3000     if {$phase == "getcommits"} {
3001         $canv itemconf textitems -font $mainfont
3002     }
3003     redisplay
3004 }
3005
3006 proc clearsha1 {} {
3007     global sha1entry sha1string
3008     if {[string length $sha1string] == 40} {
3009         $sha1entry delete 0 end
3010     }
3011 }
3012
3013 proc sha1change {n1 n2 op} {
3014     global sha1string currentid sha1but
3015     if {$sha1string == {}
3016         || ([info exists currentid] && $sha1string == $currentid)} {
3017         set state disabled
3018     } else {
3019         set state normal
3020     }
3021     if {[$sha1but cget -state] == $state} return
3022     if {$state == "normal"} {
3023         $sha1but conf -state normal -relief raised -text "Goto: "
3024     } else {
3025         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3026     }
3027 }
3028
3029 proc gotocommit {} {
3030     global sha1string currentid idline tagids
3031     global lineid numcommits
3032
3033     if {$sha1string == {}
3034         || ([info exists currentid] && $sha1string == $currentid)} return
3035     if {[info exists tagids($sha1string)]} {
3036         set id $tagids($sha1string)
3037     } else {
3038         set id [string tolower $sha1string]
3039         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3040             set matches {}
3041             for {set l 0} {$l < $numcommits} {incr l} {
3042                 if {[string match $id* $lineid($l)]} {
3043                     lappend matches $lineid($l)
3044                 }
3045             }
3046             if {$matches ne {}} {
3047                 if {[llength $matches] > 1} {
3048                     error_popup "Short SHA1 id $id is ambiguous"
3049                     return
3050                 }
3051                 set id [lindex $matches 0]
3052             }
3053         }
3054     }
3055     if {[info exists idline($id)]} {
3056         selectline $idline($id) 1
3057         return
3058     }
3059     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3060         set type "SHA1 id"
3061     } else {
3062         set type "Tag"
3063     }
3064     error_popup "$type $sha1string is not known"
3065 }
3066
3067 proc lineenter {x y id} {
3068     global hoverx hovery hoverid hovertimer
3069     global commitinfo canv
3070
3071     if {![info exists commitinfo($id)]} return
3072     set hoverx $x
3073     set hovery $y
3074     set hoverid $id
3075     if {[info exists hovertimer]} {
3076         after cancel $hovertimer
3077     }
3078     set hovertimer [after 500 linehover]
3079     $canv delete hover
3080 }
3081
3082 proc linemotion {x y id} {
3083     global hoverx hovery hoverid hovertimer
3084
3085     if {[info exists hoverid] && $id == $hoverid} {
3086         set hoverx $x
3087         set hovery $y
3088         if {[info exists hovertimer]} {
3089             after cancel $hovertimer
3090         }
3091         set hovertimer [after 500 linehover]
3092     }
3093 }
3094
3095 proc lineleave {id} {
3096     global hoverid hovertimer canv
3097
3098     if {[info exists hoverid] && $id == $hoverid} {
3099         $canv delete hover
3100         if {[info exists hovertimer]} {
3101             after cancel $hovertimer
3102             unset hovertimer
3103         }
3104         unset hoverid
3105     }
3106 }
3107
3108 proc linehover {} {
3109     global hoverx hovery hoverid hovertimer
3110     global canv linespc lthickness
3111     global commitinfo mainfont
3112
3113     set text [lindex $commitinfo($hoverid) 0]
3114     set ymax [lindex [$canv cget -scrollregion] 3]
3115     if {$ymax == {}} return
3116     set yfrac [lindex [$canv yview] 0]
3117     set x [expr {$hoverx + 2 * $linespc}]
3118     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3119     set x0 [expr {$x - 2 * $lthickness}]
3120     set y0 [expr {$y - 2 * $lthickness}]
3121     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3122     set y1 [expr {$y + $linespc + 2 * $lthickness}]
3123     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3124                -fill \#ffff80 -outline black -width 1 -tags hover]
3125     $canv raise $t
3126     set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3127     $canv raise $t
3128 }
3129
3130 proc clickisonarrow {id y} {
3131     global mainline mainlinearrow sidelines lthickness
3132
3133     set thresh [expr {2 * $lthickness + 6}]
3134     if {[info exists mainline($id)]} {
3135         if {$mainlinearrow($id) ne "none"} {
3136             if {abs([lindex $mainline($id) 1] - $y) < $thresh} {
3137                 return "up"
3138             }
3139         }
3140     }
3141     if {[info exists sidelines($id)]} {
3142         foreach ls $sidelines($id) {
3143             set coords [lindex $ls 0]
3144             set arrow [lindex $ls 2]
3145             if {$arrow eq "first" || $arrow eq "both"} {
3146                 if {abs([lindex $coords 1] - $y) < $thresh} {
3147                     return "up"
3148                 }
3149             }
3150             if {$arrow eq "last" || $arrow eq "both"} {
3151                 if {abs([lindex $coords end] - $y) < $thresh} {
3152                     return "down"
3153                 }
3154             }
3155         }
3156     }
3157     return {}
3158 }
3159
3160 proc arrowjump {id dirn y} {
3161     global mainline sidelines canv canv2 canv3
3162
3163     set yt {}
3164     if {$dirn eq "down"} {
3165         if {[info exists mainline($id)]} {
3166             set y1 [lindex $mainline($id) 1]
3167             if {$y1 > $y} {
3168                 set yt $y1
3169             }
3170         }
3171         if {[info exists sidelines($id)]} {
3172             foreach ls $sidelines($id) {
3173                 set y1 [lindex $ls 0 1]
3174                 if {$y1 > $y && ($yt eq {} || $y1 < $yt)} {
3175                     set yt $y1
3176                 }
3177             }
3178         }
3179     } else {
3180         if {[info exists sidelines($id)]} {
3181             foreach ls $sidelines($id) {
3182                 set y1 [lindex $ls 0 end]
3183                 if {$y1 < $y && ($yt eq {} || $y1 > $yt)} {
3184                     set yt $y1
3185                 }
3186             }
3187         }
3188     }
3189     if {$yt eq {}} return
3190     set ymax [lindex [$canv cget -scrollregion] 3]
3191     if {$ymax eq {} || $ymax <= 0} return
3192     set view [$canv yview]
3193     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3194     set yfrac [expr {$yt / $ymax - $yspan / 2}]
3195     if {$yfrac < 0} {
3196         set yfrac 0
3197     }
3198     $canv yview moveto $yfrac
3199     $canv2 yview moveto $yfrac
3200     $canv3 yview moveto $yfrac
3201 }
3202
3203 proc lineclick {x y id isnew} {
3204     global ctext commitinfo children cflist canv thickerline
3205
3206     unmarkmatches
3207     unselectline
3208     normalline
3209     $canv delete hover
3210     # draw this line thicker than normal
3211     drawlines $id 1 1
3212     set thickerline $id
3213     if {$isnew} {
3214         set ymax [lindex [$canv cget -scrollregion] 3]
3215         if {$ymax eq {}} return
3216         set yfrac [lindex [$canv yview] 0]
3217         set y [expr {$y + $yfrac * $ymax}]
3218     }
3219     set dirn [clickisonarrow $id $y]
3220     if {$dirn ne {}} {
3221         arrowjump $id $dirn $y
3222         return
3223     }
3224
3225     if {$isnew} {
3226         addtohistory [list lineclick $x $y $id 0]
3227     }
3228     # fill the details pane with info about this line
3229     $ctext conf -state normal
3230     $ctext delete 0.0 end
3231     $ctext tag conf link -foreground blue -underline 1
3232     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3233     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3234     $ctext insert end "Parent:\t"
3235     $ctext insert end $id [list link link0]
3236     $ctext tag bind link0 <1> [list selbyid $id]
3237     set info $commitinfo($id)
3238     $ctext insert end "\n\t[lindex $info 0]\n"
3239     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3240     set date [formatdate [lindex $info 2]]
3241     $ctext insert end "\tDate:\t$date\n"
3242     if {[info exists children($id)]} {
3243         $ctext insert end "\nChildren:"
3244         set i 0
3245         foreach child $children($id) {
3246             incr i
3247             set info $commitinfo($child)
3248             $ctext insert end "\n\t"
3249             $ctext insert end $child [list link link$i]
3250             $ctext tag bind link$i <1> [list selbyid $child]
3251             $ctext insert end "\n\t[lindex $info 0]"
3252             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3253             set date [formatdate [lindex $info 2]]
3254             $ctext insert end "\n\tDate:\t$date\n"
3255         }
3256     }
3257     $ctext conf -state disabled
3258
3259     $cflist delete 0 end
3260 }
3261
3262 proc normalline {} {
3263     global thickerline
3264     if {[info exists thickerline]} {
3265         drawlines $thickerline 0 1
3266         unset thickerline
3267     }
3268 }
3269
3270 proc selbyid {id} {
3271     global idline
3272     if {[info exists idline($id)]} {
3273         selectline $idline($id) 1
3274     }
3275 }
3276
3277 proc mstime {} {
3278     global startmstime
3279     if {![info exists startmstime]} {
3280         set startmstime [clock clicks -milliseconds]
3281     }
3282     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3283 }
3284
3285 proc rowmenu {x y id} {
3286     global rowctxmenu idline selectedline rowmenuid
3287
3288     if {![info exists selectedline] || $idline($id) eq $selectedline} {
3289         set state disabled
3290     } else {
3291         set state normal
3292     }
3293     $rowctxmenu entryconfigure 0 -state $state
3294     $rowctxmenu entryconfigure 1 -state $state
3295     $rowctxmenu entryconfigure 2 -state $state
3296     set rowmenuid $id
3297     tk_popup $rowctxmenu $x $y
3298 }
3299
3300 proc diffvssel {dirn} {
3301     global rowmenuid selectedline lineid
3302
3303     if {![info exists selectedline]} return
3304     if {$dirn} {
3305         set oldid $lineid($selectedline)
3306         set newid $rowmenuid
3307     } else {
3308         set oldid $rowmenuid
3309         set newid $lineid($selectedline)
3310     }
3311     addtohistory [list doseldiff $oldid $newid]
3312     doseldiff $oldid $newid
3313 }
3314
3315 proc doseldiff {oldid newid} {
3316     global ctext cflist
3317     global commitinfo
3318
3319     $ctext conf -state normal
3320     $ctext delete 0.0 end
3321     $ctext mark set fmark.0 0.0
3322     $ctext mark gravity fmark.0 left
3323     $cflist delete 0 end
3324     $cflist insert end "Top"
3325     $ctext insert end "From "
3326     $ctext tag conf link -foreground blue -underline 1
3327     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3328     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3329     $ctext tag bind link0 <1> [list selbyid $oldid]
3330     $ctext insert end $oldid [list link link0]
3331     $ctext insert end "\n     "
3332     $ctext insert end [lindex $commitinfo($oldid) 0]
3333     $ctext insert end "\n\nTo   "
3334     $ctext tag bind link1 <1> [list selbyid $newid]
3335     $ctext insert end $newid [list link link1]
3336     $ctext insert end "\n     "
3337     $ctext insert end [lindex $commitinfo($newid) 0]
3338     $ctext insert end "\n"
3339     $ctext conf -state disabled
3340     $ctext tag delete Comments
3341     $ctext tag remove found 1.0 end
3342     startdiff [list $oldid $newid]
3343 }
3344
3345 proc mkpatch {} {
3346     global rowmenuid currentid commitinfo patchtop patchnum
3347
3348     if {![info exists currentid]} return
3349     set oldid $currentid
3350     set oldhead [lindex $commitinfo($oldid) 0]
3351     set newid $rowmenuid
3352     set newhead [lindex $commitinfo($newid) 0]
3353     set top .patch
3354     set patchtop $top
3355     catch {destroy $top}
3356     toplevel $top
3357     label $top.title -text "Generate patch"
3358     grid $top.title - -pady 10
3359     label $top.from -text "From:"
3360     entry $top.fromsha1 -width 40 -relief flat
3361     $top.fromsha1 insert 0 $oldid
3362     $top.fromsha1 conf -state readonly
3363     grid $top.from $top.fromsha1 -sticky w
3364     entry $top.fromhead -width 60 -relief flat
3365     $top.fromhead insert 0 $oldhead
3366     $top.fromhead conf -state readonly
3367     grid x $top.fromhead -sticky w
3368     label $top.to -text "To:"
3369     entry $top.tosha1 -width 40 -relief flat
3370     $top.tosha1 insert 0 $newid
3371     $top.tosha1 conf -state readonly
3372     grid $top.to $top.tosha1 -sticky w
3373     entry $top.tohead -width 60 -relief flat
3374     $top.tohead insert 0 $newhead
3375     $top.tohead conf -state readonly
3376     grid x $top.tohead -sticky w
3377     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3378     grid $top.rev x -pady 10
3379     label $top.flab -text "Output file:"
3380     entry $top.fname -width 60
3381     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3382     incr patchnum
3383     grid $top.flab $top.fname -sticky w
3384     frame $top.buts
3385     button $top.buts.gen -text "Generate" -command mkpatchgo
3386     button $top.buts.can -text "Cancel" -command mkpatchcan
3387     grid $top.buts.gen $top.buts.can
3388     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3389     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3390     grid $top.buts - -pady 10 -sticky ew
3391     focus $top.fname
3392 }
3393
3394 proc mkpatchrev {} {
3395     global patchtop
3396
3397     set oldid [$patchtop.fromsha1 get]
3398     set oldhead [$patchtop.fromhead get]
3399     set newid [$patchtop.tosha1 get]
3400     set newhead [$patchtop.tohead get]
3401     foreach e [list fromsha1 fromhead tosha1 tohead] \
3402             v [list $newid $newhead $oldid $oldhead] {
3403         $patchtop.$e conf -state normal
3404         $patchtop.$e delete 0 end
3405         $patchtop.$e insert 0 $v
3406         $patchtop.$e conf -state readonly
3407     }
3408 }
3409
3410 proc mkpatchgo {} {
3411     global patchtop
3412
3413     set oldid [$patchtop.fromsha1 get]
3414     set newid [$patchtop.tosha1 get]
3415     set fname [$patchtop.fname get]
3416     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3417         error_popup "Error creating patch: $err"
3418     }
3419     catch {destroy $patchtop}
3420     unset patchtop
3421 }
3422
3423 proc mkpatchcan {} {
3424     global patchtop
3425
3426     catch {destroy $patchtop}
3427     unset patchtop
3428 }
3429
3430 proc mktag {} {
3431     global rowmenuid mktagtop commitinfo
3432
3433     set top .maketag
3434     set mktagtop $top
3435     catch {destroy $top}
3436     toplevel $top
3437     label $top.title -text "Create tag"
3438     grid $top.title - -pady 10
3439     label $top.id -text "ID:"
3440     entry $top.sha1 -width 40 -relief flat
3441     $top.sha1 insert 0 $rowmenuid
3442     $top.sha1 conf -state readonly
3443     grid $top.id $top.sha1 -sticky w
3444     entry $top.head -width 60 -relief flat
3445     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3446     $top.head conf -state readonly
3447     grid x $top.head -sticky w
3448     label $top.tlab -text "Tag name:"
3449     entry $top.tag -width 60
3450     grid $top.tlab $top.tag -sticky w
3451     frame $top.buts
3452     button $top.buts.gen -text "Create" -command mktaggo
3453     button $top.buts.can -text "Cancel" -command mktagcan
3454     grid $top.buts.gen $top.buts.can
3455     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3456     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3457     grid $top.buts - -pady 10 -sticky ew
3458     focus $top.tag
3459 }
3460
3461 proc domktag {} {
3462     global mktagtop env tagids idtags
3463
3464     set id [$mktagtop.sha1 get]
3465     set tag [$mktagtop.tag get]
3466     if {$tag == {}} {
3467         error_popup "No tag name specified"
3468         return
3469     }
3470     if {[info exists tagids($tag)]} {
3471         error_popup "Tag \"$tag\" already exists"
3472         return
3473     }
3474     if {[catch {
3475         set dir [gitdir]
3476         set fname [file join $dir "refs/tags" $tag]
3477         set f [open $fname w]
3478         puts $f $id
3479         close $f
3480     } err]} {
3481         error_popup "Error creating tag: $err"
3482         return
3483     }
3484
3485     set tagids($tag) $id
3486     lappend idtags($id) $tag
3487     redrawtags $id
3488 }
3489
3490 proc redrawtags {id} {
3491     global canv linehtag idline idpos selectedline
3492
3493     if {![info exists idline($id)]} return
3494     $canv delete tag.$id
3495     set xt [eval drawtags $id $idpos($id)]
3496     $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3497     if {[info exists selectedline] && $selectedline == $idline($id)} {
3498         selectline $selectedline 0
3499     }
3500 }
3501
3502 proc mktagcan {} {
3503     global mktagtop
3504
3505     catch {destroy $mktagtop}
3506     unset mktagtop
3507 }
3508
3509 proc mktaggo {} {
3510     domktag
3511     mktagcan
3512 }
3513
3514 proc writecommit {} {
3515     global rowmenuid wrcomtop commitinfo wrcomcmd
3516
3517     set top .writecommit
3518     set wrcomtop $top
3519     catch {destroy $top}
3520     toplevel $top
3521     label $top.title -text "Write commit to file"
3522     grid $top.title - -pady 10
3523     label $top.id -text "ID:"
3524     entry $top.sha1 -width 40 -relief flat
3525     $top.sha1 insert 0 $rowmenuid
3526     $top.sha1 conf -state readonly
3527     grid $top.id $top.sha1 -sticky w
3528     entry $top.head -width 60 -relief flat
3529     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3530     $top.head conf -state readonly
3531     grid x $top.head -sticky w
3532     label $top.clab -text "Command:"
3533     entry $top.cmd -width 60 -textvariable wrcomcmd
3534     grid $top.clab $top.cmd -sticky w -pady 10
3535     label $top.flab -text "Output file:"
3536     entry $top.fname -width 60
3537     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3538     grid $top.flab $top.fname -sticky w
3539     frame $top.buts
3540     button $top.buts.gen -text "Write" -command wrcomgo
3541     button $top.buts.can -text "Cancel" -command wrcomcan
3542     grid $top.buts.gen $top.buts.can
3543     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3544     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3545     grid $top.buts - -pady 10 -sticky ew
3546     focus $top.fname
3547 }
3548
3549 proc wrcomgo {} {
3550     global wrcomtop
3551
3552     set id [$wrcomtop.sha1 get]
3553     set cmd "echo $id | [$wrcomtop.cmd get]"
3554     set fname [$wrcomtop.fname get]
3555     if {[catch {exec sh -c $cmd >$fname &} err]} {
3556         error_popup "Error writing commit: $err"
3557     }
3558     catch {destroy $wrcomtop}
3559     unset wrcomtop
3560 }
3561
3562 proc wrcomcan {} {
3563     global wrcomtop
3564
3565     catch {destroy $wrcomtop}
3566     unset wrcomtop
3567 }
3568
3569 proc listrefs {id} {
3570     global idtags idheads idotherrefs
3571
3572     set x {}
3573     if {[info exists idtags($id)]} {
3574         set x $idtags($id)
3575     }
3576     set y {}
3577     if {[info exists idheads($id)]} {
3578         set y $idheads($id)
3579     }
3580     set z {}
3581     if {[info exists idotherrefs($id)]} {
3582         set z $idotherrefs($id)
3583     }
3584     return [list $x $y $z]
3585 }
3586
3587 proc rereadrefs {} {
3588     global idtags idheads idotherrefs
3589     global tagids headids otherrefids
3590
3591     set refids [concat [array names idtags] \
3592                     [array names idheads] [array names idotherrefs]]
3593     foreach id $refids {
3594         if {![info exists ref($id)]} {
3595             set ref($id) [listrefs $id]
3596         }
3597     }
3598     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
3599         catch {unset $v}
3600     }
3601     readrefs
3602     set refids [lsort -unique [concat $refids [array names idtags] \
3603                         [array names idheads] [array names idotherrefs]]]
3604     foreach id $refids {
3605         set v [listrefs $id]
3606         if {![info exists ref($id)] || $ref($id) != $v} {
3607             redrawtags $id
3608         }
3609     }
3610 }
3611
3612 proc showtag {tag isnew} {
3613     global ctext cflist tagcontents tagids linknum
3614
3615     if {$isnew} {
3616         addtohistory [list showtag $tag 0]
3617     }
3618     $ctext conf -state normal
3619     $ctext delete 0.0 end
3620     set linknum 0
3621     if {[info exists tagcontents($tag)]} {
3622         set text $tagcontents($tag)
3623     } else {
3624         set text "Tag: $tag\nId:  $tagids($tag)"
3625     }
3626     appendwithlinks $text
3627     $ctext conf -state disabled
3628     $cflist delete 0 end
3629 }
3630
3631 proc doquit {} {
3632     global stopped
3633     set stopped 100
3634     destroy .
3635 }
3636
3637 proc formatdate {d} {
3638     global hours nhours tfd fastdate
3639
3640     if {!$fastdate} {
3641         return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3642     }
3643     set hr [expr {$d / 3600}]
3644     set ms [expr {$d % 3600}]
3645     if {![info exists hours($hr)]} {
3646         set hours($hr) [clock format $d -format "%Y-%m-%d %H"]
3647         set nhours($hr) 0
3648     }
3649     incr nhours($hr)
3650     set minsec [format "%.2d:%.2d" [expr {$ms/60}] [expr {$ms%60}]]
3651     return "$hours($hr):$minsec"
3652 }
3653
3654 # defaults...
3655 set datemode 0
3656 set boldnames 0
3657 set diffopts "-U 5 -p"
3658 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3659 set gitencoding "utf-8"
3660
3661 set mainfont {Helvetica 9}
3662 set textfont {Courier 9}
3663 set findmergefiles 0
3664 set gaudydiff 0
3665 set maxgraphpct 50
3666 set maxwidth 16
3667 set revlistorder 0
3668 set fastdate 0
3669
3670 set colors {green red blue magenta darkgrey brown orange}
3671
3672 catch {source ~/.gitk}
3673
3674 set namefont $mainfont
3675 if {$boldnames} {
3676     lappend namefont bold
3677 }
3678
3679 set revtreeargs {}
3680 foreach arg $argv {
3681     switch -regexp -- $arg {
3682         "^$" { }
3683         "^-b" { set boldnames 1 }
3684         "^-d" { set datemode 1 }
3685         "^-r" { set revlistorder 1 }
3686         default {
3687             lappend revtreeargs $arg
3688         }
3689     }
3690 }
3691
3692 set history {}
3693 set historyindex 0
3694
3695 set stopped 0
3696 set redisplaying 0
3697 set stuffsaved 0
3698 set patchnum 0
3699 setcoords
3700 makewindow
3701 readrefs
3702 getcommits $revtreeargs