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