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