gitk

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