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