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         set onscreen($id) 1
1023     }
1024
1025     # remove the null entry if present
1026     set nullentry [lsearch -exact $displist {}]
1027     if {$nullentry >= 0} {
1028         set displist [lreplace $displist $nullentry $nullentry]
1029     }
1030
1031     # bring back the ones we need now (if we did it earlier
1032     # it would change displist and invalidate olddlevel)
1033     foreach pi $reins {
1034         # test again in case of duplicates in reins
1035         set p [lindex $pi 0]
1036         if {$onscreen($p) < 0} {
1037             set onscreen($p) 1
1038             set lastuse($p) $lineno
1039             set displist [linsert $displist [lindex $pi 1] $p]
1040             incr nhyperspace -1
1041         }
1042     }
1043
1044     set lastuse($id) $lineno
1045
1046     # see if we need to make any lines jump off into hyperspace
1047     set displ [llength $displist]
1048     if {$displ > $maxwidth} {
1049         set ages {}
1050         foreach x $displist {
1051             lappend ages [list $lastuse($x) $x]
1052         }
1053         set ages [lsort -integer -index 0 $ages]
1054         set k 0
1055         while {$displ > $maxwidth} {
1056             set use [lindex $ages $k 0]
1057             set victim [lindex $ages $k 1]
1058             if {$use >= $lineno - 5} break
1059             incr k
1060             if {[lsearch -exact $nohs $victim] >= 0} continue
1061             set i [lsearch -exact $displist $victim]
1062             set displist [lreplace $displist $i $i]
1063             set onscreen($victim) -1
1064             incr nhyperspace
1065             incr displ -1
1066             if {$i < $nullentry} {
1067                 incr nullentry -1
1068             }
1069             set x [lindex $mainline($victim) end-1]
1070             lappend mainline($victim) $x $y1
1071             set line [trimdiagend $mainline($victim)]
1072             set arrow "last"
1073             if {$mainlinearrow($victim) ne "none"} {
1074                 set line [trimdiagstart $line]
1075                 set arrow "both"
1076             }
1077             lappend sidelines($victim) [list $line 1 $arrow]
1078             unset mainline($victim)
1079         }
1080     }
1081
1082     set dlevel [lsearch -exact $displist $id]
1083
1084     # If we are reducing, put in a null entry
1085     if {$displ < $oldnlines} {
1086         # does the next line look like a merge?
1087         # i.e. does it have > 1 new parent?
1088         if {$nnewparents($id) > 1} {
1089             set i [expr {$dlevel + 1}]
1090         } elseif {$nnewparents([lindex $olddisplist $olddlevel]) == 0} {
1091             set i $olddlevel
1092             if {$nullentry >= 0 && $nullentry < $i} {
1093                 incr i -1
1094             }
1095         } elseif {$nullentry >= 0} {
1096             set i $nullentry
1097             while {$i < $displ
1098                    && [lindex $olddisplist $i] == [lindex $displist $i]} {
1099                 incr i
1100             }
1101         } else {
1102             set i $olddlevel
1103             if {$dlevel >= $i} {
1104                 incr i
1105             }
1106         }
1107         if {$i < $displ} {
1108             set displist [linsert $displist $i {}]
1109             incr displ
1110             if {$dlevel >= $i} {
1111                 incr dlevel
1112             }
1113         }
1114     }
1115
1116     # decide on the line spacing for the next line
1117     set lj [expr {$lineno + 1}]
1118     set maxw [expr {$maxgraphpct * $geometry(canv1) / 100}]
1119     if {$displ <= 1 || $canvx0 + $displ * $xspc2 <= $maxw} {
1120         set xspc1($lj) $xspc2
1121     } else {
1122         set xspc1($lj) [expr {($maxw - $canvx0 - $xspc2) / ($displ - 1)}]
1123         if {$xspc1($lj) < $lthickness} {
1124             set xspc1($lj) $lthickness
1125         }
1126     }
1127
1128     foreach idi $reins {
1129         set id [lindex $idi 0]
1130         set j [lsearch -exact $displist $id]
1131         set xj [xcoord $j $dlevel $lj]
1132         set mainline($id) [list $xj $y2]
1133         set mainlinearrow($id) first
1134     }
1135
1136     set i -1
1137     foreach id $olddisplist {
1138         incr i
1139         if {$id == {}} continue
1140         if {$onscreen($id) <= 0} continue
1141         set xi [xcoord $i $olddlevel $lineno]
1142         if {$i == $olddlevel} {
1143             foreach p $currentparents {
1144                 set j [lsearch -exact $displist $p]
1145                 set coords [list $xi $y1]
1146                 set xj [xcoord $j $dlevel $lj]
1147                 if {$xj < $xi - $linespc} {
1148                     lappend coords [expr {$xj + $linespc}] $y1
1149                     notecrossings $p $j $i [expr {$j + 1}]
1150                 } elseif {$xj > $xi + $linespc} {
1151                     lappend coords [expr {$xj - $linespc}] $y1
1152                     notecrossings $p $i $j [expr {$j - 1}]
1153                 }
1154                 if {[lsearch -exact $dupparents $p] >= 0} {
1155                     # draw a double-width line to indicate the doubled parent
1156                     lappend coords $xj $y2
1157                     lappend sidelines($p) [list $coords 2 none]
1158                     if {![info exists mainline($p)]} {
1159                         set mainline($p) [list $xj $y2]
1160                         set mainlinearrow($p) none
1161                     }
1162                 } else {
1163                     # normal case, no parent duplicated
1164                     set yb $y2
1165                     set dx [expr {abs($xi - $xj)}]
1166                     if {0 && $dx < $linespc} {
1167                         set yb [expr {$y1 + $dx}]
1168                     }
1169                     if {![info exists mainline($p)]} {
1170                         if {$xi != $xj} {
1171                             lappend coords $xj $yb
1172                         }
1173                         set mainline($p) $coords
1174                         set mainlinearrow($p) none
1175                     } else {
1176                         lappend coords $xj $yb
1177                         if {$yb < $y2} {
1178                             lappend coords $xj $y2
1179                         }
1180                         lappend sidelines($p) [list $coords 1 none]
1181                     }
1182                 }
1183             }
1184         } else {
1185             set j $i
1186             if {[lindex $displist $i] != $id} {
1187                 set j [lsearch -exact $displist $id]
1188             }
1189             if {$j != $i || $xspc1($lineno) != $xspc1($lj)
1190                 || ($olddlevel < $i && $i < $dlevel)
1191                 || ($dlevel < $i && $i < $olddlevel)} {
1192                 set xj [xcoord $j $dlevel $lj]
1193                 lappend mainline($id) $xi $y1 $xj $y2
1194             }
1195         }
1196     }
1197     return $dlevel
1198 }
1199
1200 # search for x in a list of lists
1201 proc llsearch {llist x} {
1202     set i 0
1203     foreach l $llist {
1204         if {$l == $x || [lsearch -exact $l $x] >= 0} {
1205             return $i
1206         }
1207         incr i
1208     }
1209     return -1
1210 }
1211
1212 proc drawmore {reading} {
1213     global displayorder numcommits ncmupdate nextupdate
1214     global stopped nhyperspace parents commitlisted
1215     global maxwidth onscreen displist currentparents olddlevel
1216
1217     set n [llength $displayorder]
1218     while {$numcommits < $n} {
1219         set id [lindex $displayorder $numcommits]
1220         set ctxend [expr {$numcommits + 10}]
1221         if {!$reading && $ctxend > $n} {
1222             set ctxend $n
1223         }
1224         set dlist {}
1225         if {$numcommits > 0} {
1226             set dlist [lreplace $displist $olddlevel $olddlevel]
1227             set i $olddlevel
1228             foreach p $currentparents {
1229                 if {$onscreen($p) == 0} {
1230                     set dlist [linsert $dlist $i $p]
1231                     incr i
1232                 }
1233             }
1234         }
1235         set nohs {}
1236         set reins {}
1237         set isfat [expr {[llength $dlist] > $maxwidth}]
1238         if {$nhyperspace > 0 || $isfat} {
1239             if {$ctxend > $n} break
1240             # work out what to bring back and
1241             # what we want to don't want to send into hyperspace
1242             set room 1
1243             for {set k $numcommits} {$k < $ctxend} {incr k} {
1244                 set x [lindex $displayorder $k]
1245                 set i [llsearch $dlist $x]
1246                 if {$i < 0} {
1247                     set i [llength $dlist]
1248                     lappend dlist $x
1249                 }
1250                 if {[lsearch -exact $nohs $x] < 0} {
1251                     lappend nohs $x
1252                 }
1253                 if {$reins eq {} && $onscreen($x) < 0 && $room} {
1254                     set reins [list $x $i]
1255                 }
1256                 set newp {}
1257                 if {[info exists commitlisted($x)]} {
1258                     set right 0
1259                     foreach p $parents($x) {
1260                         if {[llsearch $dlist $p] < 0} {
1261                             lappend newp $p
1262                             if {[lsearch -exact $nohs $p] < 0} {
1263                                 lappend nohs $p
1264                             }
1265                             if {$reins eq {} && $onscreen($p) < 0 && $room} {
1266                                 set reins [list $p [expr {$i + $right}]]
1267                             }
1268                         }
1269                         set right 1
1270                     }
1271                 }
1272                 set l [lindex $dlist $i]
1273                 if {[llength $l] == 1} {
1274                     set l $newp
1275                 } else {
1276                     set j [lsearch -exact $l $x]
1277                     set l [concat [lreplace $l $j $j] $newp]
1278                 }
1279                 set dlist [lreplace $dlist $i $i $l]
1280                 if {$room && $isfat && [llength $newp] <= 1} {
1281                     set room 0
1282                 }
1283             }
1284         }
1285
1286         set dlevel [drawslants $id $reins $nohs]
1287         drawcommitline $dlevel
1288         if {[clock clicks -milliseconds] >= $nextupdate
1289             && $numcommits >= $ncmupdate} {
1290             doupdate $reading
1291             if {$stopped} break
1292         }
1293     }
1294 }
1295
1296 # level here is an index in todo
1297 proc updatetodo {level noshortcut} {
1298     global ncleft todo nnewparents
1299     global commitlisted parents onscreen
1300
1301     set id [lindex $todo $level]
1302     set olds {}
1303     if {[info exists commitlisted($id)]} {
1304         foreach p $parents($id) {
1305             if {[lsearch -exact $olds $p] < 0} {
1306                 lappend olds $p
1307             }
1308         }
1309     }
1310     if {!$noshortcut && [llength $olds] == 1} {
1311         set p [lindex $olds 0]
1312         if {$ncleft($p) == 1 && [lsearch -exact $todo $p] < 0} {
1313             set ncleft($p) 0
1314             set todo [lreplace $todo $level $level $p]
1315             set onscreen($p) 0
1316             set nnewparents($id) 1
1317             return 0
1318         }
1319     }
1320
1321     set todo [lreplace $todo $level $level]
1322     set i $level
1323     set n 0
1324     foreach p $olds {
1325         incr ncleft($p) -1
1326         set k [lsearch -exact $todo $p]
1327         if {$k < 0} {
1328             set todo [linsert $todo $i $p]
1329             set onscreen($p) 0
1330             incr i
1331             incr n
1332         }
1333     }
1334     set nnewparents($id) $n
1335
1336     return 1
1337 }
1338
1339 proc decidenext {{noread 0}} {
1340     global ncleft todo
1341     global datemode cdate
1342     global commitinfo
1343
1344     # choose which one to do next time around
1345     set todol [llength $todo]
1346     set level -1
1347     set latest {}
1348     for {set k $todol} {[incr k -1] >= 0} {} {
1349         set p [lindex $todo $k]
1350         if {$ncleft($p) == 0} {
1351             if {$datemode} {
1352                 if {![info exists commitinfo($p)]} {
1353                     if {$noread} {
1354                         return {}
1355                     }
1356                     readcommit $p
1357                 }
1358                 if {$latest == {} || $cdate($p) > $latest} {
1359                     set level $k
1360                     set latest $cdate($p)
1361                 }
1362             } else {
1363                 set level $k
1364                 break
1365             }
1366         }
1367     }
1368     if {$level < 0} {
1369         if {$todo != {}} {
1370             puts "ERROR: none of the pending commits can be done yet:"
1371             foreach p $todo {
1372                 puts "  $p ($ncleft($p))"
1373             }
1374         }
1375         return -1
1376     }
1377
1378     return $level
1379 }
1380
1381 proc drawcommit {id} {
1382     global phase todo nchildren datemode nextupdate
1383     global numcommits ncmupdate displayorder todo onscreen
1384
1385     if {$phase != "incrdraw"} {
1386         set phase incrdraw
1387         set displayorder {}
1388         set todo {}
1389         initgraph
1390     }
1391     if {$nchildren($id) == 0} {
1392         lappend todo $id
1393         set onscreen($id) 0
1394     }
1395     set level [decidenext 1]
1396     if {$level == {} || $id != [lindex $todo $level]} {
1397         return
1398     }
1399     while 1 {
1400         lappend displayorder [lindex $todo $level]
1401         if {[updatetodo $level $datemode]} {
1402             set level [decidenext 1]
1403             if {$level == {}} break
1404         }
1405         set id [lindex $todo $level]
1406         if {![info exists commitlisted($id)]} {
1407             break
1408         }
1409     }
1410     drawmore 1
1411 }
1412
1413 proc finishcommits {} {
1414     global phase
1415     global canv mainfont ctext maincursor textcursor
1416
1417     if {$phase != "incrdraw"} {
1418         $canv delete all
1419         $canv create text 3 3 -anchor nw -text "No commits selected" \
1420             -font $mainfont -tags textitems
1421         set phase {}
1422     } else {
1423         drawrest
1424     }
1425     . config -cursor $maincursor
1426     settextcursor $textcursor
1427 }
1428
1429 # Don't change the text pane cursor if it is currently the hand cursor,
1430 # showing that we are over a sha1 ID link.
1431 proc settextcursor {c} {
1432     global ctext curtextcursor
1433
1434     if {[$ctext cget -cursor] == $curtextcursor} {
1435         $ctext config -cursor $c
1436     }
1437     set curtextcursor $c
1438 }
1439
1440 proc drawgraph {} {
1441     global nextupdate startmsecs ncmupdate
1442     global displayorder onscreen
1443
1444     if {$displayorder == {}} return
1445     set startmsecs [clock clicks -milliseconds]
1446     set nextupdate [expr $startmsecs + 100]
1447     set ncmupdate 1
1448     initgraph
1449     foreach id $displayorder {
1450         set onscreen($id) 0
1451     }
1452     drawmore 0
1453 }
1454
1455 proc drawrest {} {
1456     global phase stopped redisplaying selectedline
1457     global datemode todo displayorder
1458     global numcommits ncmupdate
1459     global nextupdate startmsecs idline
1460
1461     set level [decidenext]
1462     if {$level >= 0} {
1463         set phase drawgraph
1464         while 1 {
1465             lappend displayorder [lindex $todo $level]
1466             set hard [updatetodo $level $datemode]
1467             if {$hard} {
1468                 set level [decidenext]
1469                 if {$level < 0} break
1470             }
1471         }
1472         drawmore 0
1473     }
1474     set phase {}
1475     set drawmsecs [expr [clock clicks -milliseconds] - $startmsecs]
1476     #puts "overall $drawmsecs ms for $numcommits commits"
1477     if {$redisplaying} {
1478         if {$stopped == 0 && [info exists selectedline]} {
1479             selectline $selectedline 0
1480         }
1481         if {$stopped == 1} {
1482             set stopped 0
1483             after idle drawgraph
1484         } else {
1485             set redisplaying 0
1486         }
1487     }
1488 }
1489
1490 proc findmatches {f} {
1491     global findtype foundstring foundstrlen
1492     if {$findtype == "Regexp"} {
1493         set matches [regexp -indices -all -inline $foundstring $f]
1494     } else {
1495         if {$findtype == "IgnCase"} {
1496             set str [string tolower $f]
1497         } else {
1498             set str $f
1499         }
1500         set matches {}
1501         set i 0
1502         while {[set j [string first $foundstring $str $i]] >= 0} {
1503             lappend matches [list $j [expr $j+$foundstrlen-1]]
1504             set i [expr $j + $foundstrlen]
1505         }
1506     }
1507     return $matches
1508 }
1509
1510 proc dofind {} {
1511     global findtype findloc findstring markedmatches commitinfo
1512     global numcommits lineid linehtag linentag linedtag
1513     global mainfont namefont canv canv2 canv3 selectedline
1514     global matchinglines foundstring foundstrlen
1515
1516     stopfindproc
1517     unmarkmatches
1518     focus .
1519     set matchinglines {}
1520     if {$findloc == "Pickaxe"} {
1521         findpatches
1522         return
1523     }
1524     if {$findtype == "IgnCase"} {
1525         set foundstring [string tolower $findstring]
1526     } else {
1527         set foundstring $findstring
1528     }
1529     set foundstrlen [string length $findstring]
1530     if {$foundstrlen == 0} return
1531     if {$findloc == "Files"} {
1532         findfiles
1533         return
1534     }
1535     if {![info exists selectedline]} {
1536         set oldsel -1
1537     } else {
1538         set oldsel $selectedline
1539     }
1540     set didsel 0
1541     set fldtypes {Headline Author Date Committer CDate Comment}
1542     for {set l 0} {$l < $numcommits} {incr l} {
1543         set id $lineid($l)
1544         set info $commitinfo($id)
1545         set doesmatch 0
1546         foreach f $info ty $fldtypes {
1547             if {$findloc != "All fields" && $findloc != $ty} {
1548                 continue
1549             }
1550             set matches [findmatches $f]
1551             if {$matches == {}} continue
1552             set doesmatch 1
1553             if {$ty == "Headline"} {
1554                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1555             } elseif {$ty == "Author"} {
1556                 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1557             } elseif {$ty == "Date"} {
1558                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1559             }
1560         }
1561         if {$doesmatch} {
1562             lappend matchinglines $l
1563             if {!$didsel && $l > $oldsel} {
1564                 findselectline $l
1565                 set didsel 1
1566             }
1567         }
1568     }
1569     if {$matchinglines == {}} {
1570         bell
1571     } elseif {!$didsel} {
1572         findselectline [lindex $matchinglines 0]
1573     }
1574 }
1575
1576 proc findselectline {l} {
1577     global findloc commentend ctext
1578     selectline $l 1
1579     if {$findloc == "All fields" || $findloc == "Comments"} {
1580         # highlight the matches in the comments
1581         set f [$ctext get 1.0 $commentend]
1582         set matches [findmatches $f]
1583         foreach match $matches {
1584             set start [lindex $match 0]
1585             set end [expr [lindex $match 1] + 1]
1586             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1587         }
1588     }
1589 }
1590
1591 proc findnext {restart} {
1592     global matchinglines selectedline
1593     if {![info exists matchinglines]} {
1594         if {$restart} {
1595             dofind
1596         }
1597         return
1598     }
1599     if {![info exists selectedline]} return
1600     foreach l $matchinglines {
1601         if {$l > $selectedline} {
1602             findselectline $l
1603             return
1604         }
1605     }
1606     bell
1607 }
1608
1609 proc findprev {} {
1610     global matchinglines selectedline
1611     if {![info exists matchinglines]} {
1612         dofind
1613         return
1614     }
1615     if {![info exists selectedline]} return
1616     set prev {}
1617     foreach l $matchinglines {
1618         if {$l >= $selectedline} break
1619         set prev $l
1620     }
1621     if {$prev != {}} {
1622         findselectline $prev
1623     } else {
1624         bell
1625     }
1626 }
1627
1628 proc findlocchange {name ix op} {
1629     global findloc findtype findtypemenu
1630     if {$findloc == "Pickaxe"} {
1631         set findtype Exact
1632         set state disabled
1633     } else {
1634         set state normal
1635     }
1636     $findtypemenu entryconf 1 -state $state
1637     $findtypemenu entryconf 2 -state $state
1638 }
1639
1640 proc stopfindproc {{done 0}} {
1641     global findprocpid findprocfile findids
1642     global ctext findoldcursor phase maincursor textcursor
1643     global findinprogress
1644
1645     catch {unset findids}
1646     if {[info exists findprocpid]} {
1647         if {!$done} {
1648             catch {exec kill $findprocpid}
1649         }
1650         catch {close $findprocfile}
1651         unset findprocpid
1652     }
1653     if {[info exists findinprogress]} {
1654         unset findinprogress
1655         if {$phase != "incrdraw"} {
1656             . config -cursor $maincursor
1657             settextcursor $textcursor
1658         }
1659     }
1660 }
1661
1662 proc findpatches {} {
1663     global findstring selectedline numcommits
1664     global findprocpid findprocfile
1665     global finddidsel ctext lineid findinprogress
1666     global findinsertpos
1667
1668     if {$numcommits == 0} return
1669
1670     # make a list of all the ids to search, starting at the one
1671     # after the selected line (if any)
1672     if {[info exists selectedline]} {
1673         set l $selectedline
1674     } else {
1675         set l -1
1676     }
1677     set inputids {}
1678     for {set i 0} {$i < $numcommits} {incr i} {
1679         if {[incr l] >= $numcommits} {
1680             set l 0
1681         }
1682         append inputids $lineid($l) "\n"
1683     }
1684
1685     if {[catch {
1686         set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1687                          << $inputids] r]
1688     } err]} {
1689         error_popup "Error starting search process: $err"
1690         return
1691     }
1692
1693     set findinsertpos end
1694     set findprocfile $f
1695     set findprocpid [pid $f]
1696     fconfigure $f -blocking 0
1697     fileevent $f readable readfindproc
1698     set finddidsel 0
1699     . config -cursor watch
1700     settextcursor watch
1701     set findinprogress 1
1702 }
1703
1704 proc readfindproc {} {
1705     global findprocfile finddidsel
1706     global idline matchinglines findinsertpos
1707
1708     set n [gets $findprocfile line]
1709     if {$n < 0} {
1710         if {[eof $findprocfile]} {
1711             stopfindproc 1
1712             if {!$finddidsel} {
1713                 bell
1714             }
1715         }
1716         return
1717     }
1718     if {![regexp {^[0-9a-f]{40}} $line id]} {
1719         error_popup "Can't parse git-diff-tree output: $line"
1720         stopfindproc
1721         return
1722     }
1723     if {![info exists idline($id)]} {
1724         puts stderr "spurious id: $id"
1725         return
1726     }
1727     set l $idline($id)
1728     insertmatch $l $id
1729 }
1730
1731 proc insertmatch {l id} {
1732     global matchinglines findinsertpos finddidsel
1733
1734     if {$findinsertpos == "end"} {
1735         if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1736             set matchinglines [linsert $matchinglines 0 $l]
1737             set findinsertpos 1
1738         } else {
1739             lappend matchinglines $l
1740         }
1741     } else {
1742         set matchinglines [linsert $matchinglines $findinsertpos $l]
1743         incr findinsertpos
1744     }
1745     markheadline $l $id
1746     if {!$finddidsel} {
1747         findselectline $l
1748         set finddidsel 1
1749     }
1750 }
1751
1752 proc findfiles {} {
1753     global selectedline numcommits lineid ctext
1754     global ffileline finddidsel parents nparents
1755     global findinprogress findstartline findinsertpos
1756     global treediffs fdiffids fdiffsneeded fdiffpos
1757     global findmergefiles
1758
1759     if {$numcommits == 0} return
1760
1761     if {[info exists selectedline]} {
1762         set l [expr {$selectedline + 1}]
1763     } else {
1764         set l 0
1765     }
1766     set ffileline $l
1767     set findstartline $l
1768     set diffsneeded {}
1769     set fdiffsneeded {}
1770     while 1 {
1771         set id $lineid($l)
1772         if {$findmergefiles || $nparents($id) == 1} {
1773             foreach p $parents($id) {
1774                 if {![info exists treediffs([list $id $p])]} {
1775                     append diffsneeded "$id $p\n"
1776                     lappend fdiffsneeded [list $id $p]
1777                 }
1778             }
1779         }
1780         if {[incr l] >= $numcommits} {
1781             set l 0
1782         }
1783         if {$l == $findstartline} break
1784     }
1785
1786     # start off a git-diff-tree process if needed
1787     if {$diffsneeded ne {}} {
1788         if {[catch {
1789             set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1790         } err ]} {
1791             error_popup "Error starting search process: $err"
1792             return
1793         }
1794         catch {unset fdiffids}
1795         set fdiffpos 0
1796         fconfigure $df -blocking 0
1797         fileevent $df readable [list readfilediffs $df]
1798     }
1799
1800     set finddidsel 0
1801     set findinsertpos end
1802     set id $lineid($l)
1803     set p [lindex $parents($id) 0]
1804     . config -cursor watch
1805     settextcursor watch
1806     set findinprogress 1
1807     findcont [list $id $p]
1808     update
1809 }
1810
1811 proc readfilediffs {df} {
1812     global findids fdiffids fdiffs
1813
1814     set n [gets $df line]
1815     if {$n < 0} {
1816         if {[eof $df]} {
1817             donefilediff
1818             if {[catch {close $df} err]} {
1819                 stopfindproc
1820                 bell
1821                 error_popup "Error in git-diff-tree: $err"
1822             } elseif {[info exists findids]} {
1823                 set ids $findids
1824                 stopfindproc
1825                 bell
1826                 error_popup "Couldn't find diffs for {$ids}"
1827             }
1828         }
1829         return
1830     }
1831     if {[regexp {^([0-9a-f]{40}) \(from ([0-9a-f]{40})\)} $line match id p]} {
1832         # start of a new string of diffs
1833         donefilediff
1834         set fdiffids [list $id $p]
1835         set fdiffs {}
1836     } elseif {[string match ":*" $line]} {
1837         lappend fdiffs [lindex $line 5]
1838     }
1839 }
1840
1841 proc donefilediff {} {
1842     global fdiffids fdiffs treediffs findids
1843     global fdiffsneeded fdiffpos
1844
1845     if {[info exists fdiffids]} {
1846         while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffids
1847                && $fdiffpos < [llength $fdiffsneeded]} {
1848             # git-diff-tree doesn't output anything for a commit
1849             # which doesn't change anything
1850             set nullids [lindex $fdiffsneeded $fdiffpos]
1851             set treediffs($nullids) {}
1852             if {[info exists findids] && $nullids eq $findids} {
1853                 unset findids
1854                 findcont $nullids
1855             }
1856             incr fdiffpos
1857         }
1858         incr fdiffpos
1859
1860         if {![info exists treediffs($fdiffids)]} {
1861             set treediffs($fdiffids) $fdiffs
1862         }
1863         if {[info exists findids] && $fdiffids eq $findids} {
1864             unset findids
1865             findcont $fdiffids
1866         }
1867     }
1868 }
1869
1870 proc findcont {ids} {
1871     global findids treediffs parents nparents
1872     global ffileline findstartline finddidsel
1873     global lineid numcommits matchinglines findinprogress
1874     global findmergefiles
1875
1876     set id [lindex $ids 0]
1877     set p [lindex $ids 1]
1878     set pi [lsearch -exact $parents($id) $p]
1879     set l $ffileline
1880     while 1 {
1881         if {$findmergefiles || $nparents($id) == 1} {
1882             if {![info exists treediffs($ids)]} {
1883                 set findids $ids
1884                 set ffileline $l
1885                 return
1886             }
1887             set doesmatch 0
1888             foreach f $treediffs($ids) {
1889                 set x [findmatches $f]
1890                 if {$x != {}} {
1891                     set doesmatch 1
1892                     break
1893                 }
1894             }
1895             if {$doesmatch} {
1896                 insertmatch $l $id
1897                 set pi $nparents($id)
1898             }
1899         } else {
1900             set pi $nparents($id)
1901         }
1902         if {[incr pi] >= $nparents($id)} {
1903             set pi 0
1904             if {[incr l] >= $numcommits} {
1905                 set l 0
1906             }
1907             if {$l == $findstartline} break
1908             set id $lineid($l)
1909         }
1910         set p [lindex $parents($id) $pi]
1911         set ids [list $id $p]
1912     }
1913     stopfindproc
1914     if {!$finddidsel} {
1915         bell
1916     }
1917 }
1918
1919 # mark a commit as matching by putting a yellow background
1920 # behind the headline
1921 proc markheadline {l id} {
1922     global canv mainfont linehtag commitinfo
1923
1924     set bbox [$canv bbox $linehtag($l)]
1925     set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
1926     $canv lower $t
1927 }
1928
1929 # mark the bits of a headline, author or date that match a find string
1930 proc markmatches {canv l str tag matches font} {
1931     set bbox [$canv bbox $tag]
1932     set x0 [lindex $bbox 0]
1933     set y0 [lindex $bbox 1]
1934     set y1 [lindex $bbox 3]
1935     foreach match $matches {
1936         set start [lindex $match 0]
1937         set end [lindex $match 1]
1938         if {$start > $end} continue
1939         set xoff [font measure $font [string range $str 0 [expr $start-1]]]
1940         set xlen [font measure $font [string range $str 0 [expr $end]]]
1941         set t [$canv create rect [expr $x0+$xoff] $y0 [expr $x0+$xlen+2] $y1 \
1942                    -outline {} -tags matches -fill yellow]
1943         $canv lower $t
1944     }
1945 }
1946
1947 proc unmarkmatches {} {
1948     global matchinglines findids
1949     allcanvs delete matches
1950     catch {unset matchinglines}
1951     catch {unset findids}
1952 }
1953
1954 proc selcanvline {w x y} {
1955     global canv canvy0 ctext linespc
1956     global lineid linehtag linentag linedtag rowtextx
1957     set ymax [lindex [$canv cget -scrollregion] 3]
1958     if {$ymax == {}} return
1959     set yfrac [lindex [$canv yview] 0]
1960     set y [expr {$y + $yfrac * $ymax}]
1961     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
1962     if {$l < 0} {
1963         set l 0
1964     }
1965     if {$w eq $canv} {
1966         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
1967     }
1968     unmarkmatches
1969     selectline $l 1
1970 }
1971
1972 proc commit_descriptor {p} {
1973     global commitinfo
1974     set l "..."
1975     if {[info exists commitinfo($p)]} {
1976         set l [lindex $commitinfo($p) 0]
1977     }
1978     return "$p ($l)"
1979 }
1980
1981 proc selectline {l isnew} {
1982     global canv canv2 canv3 ctext commitinfo selectedline
1983     global lineid linehtag linentag linedtag
1984     global canvy0 linespc parents nparents children
1985     global cflist currentid sha1entry
1986     global commentend idtags idline
1987
1988     $canv delete hover
1989     if {![info exists lineid($l)] || ![info exists linehtag($l)]} return
1990     $canv delete secsel
1991     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
1992                -tags secsel -fill [$canv cget -selectbackground]]
1993     $canv lower $t
1994     $canv2 delete secsel
1995     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
1996                -tags secsel -fill [$canv2 cget -selectbackground]]
1997     $canv2 lower $t
1998     $canv3 delete secsel
1999     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2000                -tags secsel -fill [$canv3 cget -selectbackground]]
2001     $canv3 lower $t
2002     set y [expr {$canvy0 + $l * $linespc}]
2003     set ymax [lindex [$canv cget -scrollregion] 3]
2004     set ytop [expr {$y - $linespc - 1}]
2005     set ybot [expr {$y + $linespc + 1}]
2006     set wnow [$canv yview]
2007     set wtop [expr [lindex $wnow 0] * $ymax]
2008     set wbot [expr [lindex $wnow 1] * $ymax]
2009     set wh [expr {$wbot - $wtop}]
2010     set newtop $wtop
2011     if {$ytop < $wtop} {
2012         if {$ybot < $wtop} {
2013             set newtop [expr {$y - $wh / 2.0}]
2014         } else {
2015             set newtop $ytop
2016             if {$newtop > $wtop - $linespc} {
2017                 set newtop [expr {$wtop - $linespc}]
2018             }
2019         }
2020     } elseif {$ybot > $wbot} {
2021         if {$ytop > $wbot} {
2022             set newtop [expr {$y - $wh / 2.0}]
2023         } else {
2024             set newtop [expr {$ybot - $wh}]
2025             if {$newtop < $wtop + $linespc} {
2026                 set newtop [expr {$wtop + $linespc}]
2027             }
2028         }
2029     }
2030     if {$newtop != $wtop} {
2031         if {$newtop < 0} {
2032             set newtop 0
2033         }
2034         allcanvs yview moveto [expr $newtop * 1.0 / $ymax]
2035     }
2036
2037     if {$isnew} {
2038         addtohistory [list selectline $l 0]
2039     }
2040
2041     set selectedline $l
2042
2043     set id $lineid($l)
2044     set currentid $id
2045     $sha1entry delete 0 end
2046     $sha1entry insert 0 $id
2047     $sha1entry selection from 0
2048     $sha1entry selection to end
2049
2050     $ctext conf -state normal
2051     $ctext delete 0.0 end
2052     $ctext mark set fmark.0 0.0
2053     $ctext mark gravity fmark.0 left
2054     set info $commitinfo($id)
2055     $ctext insert end "Author: [lindex $info 1]  [lindex $info 2]\n"
2056     $ctext insert end "Committer: [lindex $info 3]  [lindex $info 4]\n"
2057     if {[info exists idtags($id)]} {
2058         $ctext insert end "Tags:"
2059         foreach tag $idtags($id) {
2060             $ctext insert end " $tag"
2061         }
2062         $ctext insert end "\n"
2063     }
2064
2065     set commentstart [$ctext index "end - 1c"]
2066     set comment {}
2067     if {[info exists parents($id)]} {
2068         foreach p $parents($id) {
2069             append comment "Parent: [commit_descriptor $p]\n"
2070         }
2071     }
2072     if {[info exists children($id)]} {
2073         foreach c $children($id) {
2074             append comment "Child:  [commit_descriptor $c]\n"
2075         }
2076     }
2077     append comment "\n"
2078     append comment [lindex $info 5]
2079     $ctext insert end $comment
2080     $ctext insert end "\n"
2081
2082     # make anything that looks like a SHA1 ID be a clickable link
2083     set links [regexp -indices -all -inline {[0-9a-f]{40}} $comment]
2084     set i 0
2085     foreach l $links {
2086         set s [lindex $l 0]
2087         set e [lindex $l 1]
2088         set linkid [string range $comment $s $e]
2089         if {![info exists idline($linkid)]} continue
2090         incr e
2091         $ctext tag add link "$commentstart + $s c" "$commentstart + $e c"
2092         $ctext tag add link$i "$commentstart + $s c" "$commentstart + $e c"
2093         $ctext tag bind link$i <1> [list selectline $idline($linkid) 1]
2094         incr i
2095     }
2096     $ctext tag conf link -foreground blue -underline 1
2097     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2098     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2099
2100     $ctext tag delete Comments
2101     $ctext tag remove found 1.0 end
2102     $ctext conf -state disabled
2103     set commentend [$ctext index "end - 1c"]
2104
2105     $cflist delete 0 end
2106     $cflist insert end "Comments"
2107     if {$nparents($id) == 1} {
2108         startdiff [concat $id $parents($id)]
2109     } elseif {$nparents($id) > 1} {
2110         mergediff $id
2111     }
2112 }
2113
2114 proc selnextline {dir} {
2115     global selectedline
2116     if {![info exists selectedline]} return
2117     set l [expr $selectedline + $dir]
2118     unmarkmatches
2119     selectline $l 1
2120 }
2121
2122 proc unselectline {} {
2123     global selectedline
2124
2125     catch {unset selectedline}
2126     allcanvs delete secsel
2127 }
2128
2129 proc addtohistory {cmd} {
2130     global history historyindex
2131
2132     if {$historyindex > 0
2133         && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2134         return
2135     }
2136
2137     if {$historyindex < [llength $history]} {
2138         set history [lreplace $history $historyindex end $cmd]
2139     } else {
2140         lappend history $cmd
2141     }
2142     incr historyindex
2143     if {$historyindex > 1} {
2144         .ctop.top.bar.leftbut conf -state normal
2145     } else {
2146         .ctop.top.bar.leftbut conf -state disabled
2147     }
2148     .ctop.top.bar.rightbut conf -state disabled
2149 }
2150
2151 proc goback {} {
2152     global history historyindex
2153
2154     if {$historyindex > 1} {
2155         incr historyindex -1
2156         set cmd [lindex $history [expr {$historyindex - 1}]]
2157         eval $cmd
2158         .ctop.top.bar.rightbut conf -state normal
2159     }
2160     if {$historyindex <= 1} {
2161         .ctop.top.bar.leftbut conf -state disabled
2162     }
2163 }
2164
2165 proc goforw {} {
2166     global history historyindex
2167
2168     if {$historyindex < [llength $history]} {
2169         set cmd [lindex $history $historyindex]
2170         incr historyindex
2171         eval $cmd
2172         .ctop.top.bar.leftbut conf -state normal
2173     }
2174     if {$historyindex >= [llength $history]} {
2175         .ctop.top.bar.rightbut conf -state disabled
2176     }
2177 }
2178
2179 proc mergediff {id} {
2180     global parents diffmergeid diffmergegca mergefilelist diffpindex
2181
2182     set diffmergeid $id
2183     set diffpindex -1
2184     set diffmergegca [findgca $parents($id)]
2185     if {[info exists mergefilelist($id)]} {
2186         if {$mergefilelist($id) ne {}} {
2187             showmergediff
2188         }
2189     } else {
2190         contmergediff {}
2191     }
2192 }
2193
2194 proc findgca {ids} {
2195     set gca {}
2196     foreach id $ids {
2197         if {$gca eq {}} {
2198             set gca $id
2199         } else {
2200             if {[catch {
2201                 set gca [exec git-merge-base $gca $id]
2202             } err]} {
2203                 return {}
2204             }
2205         }
2206     }
2207     return $gca
2208 }
2209
2210 proc contmergediff {ids} {
2211     global diffmergeid diffpindex parents nparents diffmergegca
2212     global treediffs mergefilelist diffids treepending
2213
2214     # diff the child against each of the parents, and diff
2215     # each of the parents against the GCA.
2216     while 1 {
2217         if {[lindex $ids 0] == $diffmergeid && $diffmergegca ne {}} {
2218             set ids [list [lindex $ids 1] $diffmergegca]
2219         } else {
2220             if {[incr diffpindex] >= $nparents($diffmergeid)} break
2221             set p [lindex $parents($diffmergeid) $diffpindex]
2222             set ids [list $diffmergeid $p]
2223         }
2224         if {![info exists treediffs($ids)]} {
2225             set diffids $ids
2226             if {![info exists treepending]} {
2227                 gettreediffs $ids
2228             }
2229             return
2230         }
2231     }
2232
2233     # If a file in some parent is different from the child and also
2234     # different from the GCA, then it's interesting.
2235     # If we don't have a GCA, then a file is interesting if it is
2236     # different from the child in all the parents.
2237     if {$diffmergegca ne {}} {
2238         set files {}
2239         foreach p $parents($diffmergeid) {
2240             set gcadiffs $treediffs([list $p $diffmergegca])
2241             foreach f $treediffs([list $diffmergeid $p]) {
2242                 if {[lsearch -exact $files $f] < 0
2243                     && [lsearch -exact $gcadiffs $f] >= 0} {
2244                     lappend files $f
2245                 }
2246             }
2247         }
2248         set files [lsort $files]
2249     } else {
2250         set p [lindex $parents($diffmergeid) 0]
2251         set files $treediffs([list $diffmergeid $p])
2252         for {set i 1} {$i < $nparents($diffmergeid) && $files ne {}} {incr i} {
2253             set p [lindex $parents($diffmergeid) $i]
2254             set df $treediffs([list $diffmergeid $p])
2255             set nf {}
2256             foreach f $files {
2257                 if {[lsearch -exact $df $f] >= 0} {
2258                     lappend nf $f
2259                 }
2260             }
2261             set files $nf
2262         }
2263     }
2264
2265     set mergefilelist($diffmergeid) $files
2266     if {$files ne {}} {
2267         showmergediff
2268     }
2269 }
2270
2271 proc showmergediff {} {
2272     global cflist diffmergeid mergefilelist parents
2273     global diffopts diffinhunk currentfile currenthunk filelines
2274     global diffblocked groupfilelast mergefds groupfilenum grouphunks
2275
2276     set files $mergefilelist($diffmergeid)
2277     foreach f $files {
2278         $cflist insert end $f
2279     }
2280     set env(GIT_DIFF_OPTS) $diffopts
2281     set flist {}
2282     catch {unset currentfile}
2283     catch {unset currenthunk}
2284     catch {unset filelines}
2285     catch {unset groupfilenum}
2286     catch {unset grouphunks}
2287     set groupfilelast -1
2288     foreach p $parents($diffmergeid) {
2289         set cmd [list | git-diff-tree -p $p $diffmergeid]
2290         set cmd [concat $cmd $mergefilelist($diffmergeid)]
2291         if {[catch {set f [open $cmd r]} err]} {
2292             error_popup "Error getting diffs: $err"
2293             foreach f $flist {
2294                 catch {close $f}
2295             }
2296             return
2297         }
2298         lappend flist $f
2299         set ids [list $diffmergeid $p]
2300         set mergefds($ids) $f
2301         set diffinhunk($ids) 0
2302         set diffblocked($ids) 0
2303         fconfigure $f -blocking 0
2304         fileevent $f readable [list getmergediffline $f $ids $diffmergeid]
2305     }
2306 }
2307
2308 proc getmergediffline {f ids id} {
2309     global diffmergeid diffinhunk diffoldlines diffnewlines
2310     global currentfile currenthunk
2311     global diffoldstart diffnewstart diffoldlno diffnewlno
2312     global diffblocked mergefilelist
2313     global noldlines nnewlines difflcounts filelines
2314
2315     set n [gets $f line]
2316     if {$n < 0} {
2317         if {![eof $f]} return
2318     }
2319
2320     if {!([info exists diffmergeid] && $diffmergeid == $id)} {
2321         if {$n < 0} {
2322             close $f
2323         }
2324         return
2325     }
2326
2327     if {$diffinhunk($ids) != 0} {
2328         set fi $currentfile($ids)
2329         if {$n > 0 && [regexp {^[-+ \\]} $line match]} {
2330             # continuing an existing hunk
2331             set line [string range $line 1 end]
2332             set p [lindex $ids 1]
2333             if {$match eq "-" || $match eq " "} {
2334                 set filelines($p,$fi,$diffoldlno($ids)) $line
2335                 incr diffoldlno($ids)
2336             }
2337             if {$match eq "+" || $match eq " "} {
2338                 set filelines($id,$fi,$diffnewlno($ids)) $line
2339                 incr diffnewlno($ids)
2340             }
2341             if {$match eq " "} {
2342                 if {$diffinhunk($ids) == 2} {
2343                     lappend difflcounts($ids) \
2344                         [list $noldlines($ids) $nnewlines($ids)]
2345                     set noldlines($ids) 0
2346                     set diffinhunk($ids) 1
2347                 }
2348                 incr noldlines($ids)
2349             } elseif {$match eq "-" || $match eq "+"} {
2350                 if {$diffinhunk($ids) == 1} {
2351                     lappend difflcounts($ids) [list $noldlines($ids)]
2352                     set noldlines($ids) 0
2353                     set nnewlines($ids) 0
2354                     set diffinhunk($ids) 2
2355                 }
2356                 if {$match eq "-"} {
2357                     incr noldlines($ids)
2358                 } else {
2359                     incr nnewlines($ids)
2360                 }
2361             }
2362             # and if it's \ No newline at end of line, then what?
2363             return
2364         }
2365         # end of a hunk
2366         if {$diffinhunk($ids) == 1 && $noldlines($ids) != 0} {
2367             lappend difflcounts($ids) [list $noldlines($ids)]
2368         } elseif {$diffinhunk($ids) == 2
2369                   && ($noldlines($ids) != 0 || $nnewlines($ids) != 0)} {
2370             lappend difflcounts($ids) [list $noldlines($ids) $nnewlines($ids)]
2371         }
2372         set currenthunk($ids) [list $currentfile($ids) \
2373                                    $diffoldstart($ids) $diffnewstart($ids) \
2374                                    $diffoldlno($ids) $diffnewlno($ids) \
2375                                    $difflcounts($ids)]
2376         set diffinhunk($ids) 0
2377         # -1 = need to block, 0 = unblocked, 1 = is blocked
2378         set diffblocked($ids) -1
2379         processhunks
2380         if {$diffblocked($ids) == -1} {
2381             fileevent $f readable {}
2382             set diffblocked($ids) 1
2383         }
2384     }
2385
2386     if {$n < 0} {
2387         # eof
2388         if {!$diffblocked($ids)} {
2389             close $f
2390             set currentfile($ids) [llength $mergefilelist($diffmergeid)]
2391             set currenthunk($ids) [list $currentfile($ids) 0 0 0 0 {}]
2392             processhunks
2393         }
2394     } elseif {[regexp {^diff --git a/(.*) b/} $line match fname]} {
2395         # start of a new file
2396         set currentfile($ids) \
2397             [lsearch -exact $mergefilelist($diffmergeid) $fname]
2398     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2399                    $line match f1l f1c f2l f2c rest]} {
2400         if {[info exists currentfile($ids)] && $currentfile($ids) >= 0} {
2401             # start of a new hunk
2402             if {$f1l == 0 && $f1c == 0} {
2403                 set f1l 1
2404             }
2405             if {$f2l == 0 && $f2c == 0} {
2406                 set f2l 1
2407             }
2408             set diffinhunk($ids) 1
2409             set diffoldstart($ids) $f1l
2410             set diffnewstart($ids) $f2l
2411             set diffoldlno($ids) $f1l
2412             set diffnewlno($ids) $f2l
2413             set difflcounts($ids) {}
2414             set noldlines($ids) 0
2415             set nnewlines($ids) 0
2416         }
2417     }
2418 }
2419
2420 proc processhunks {} {
2421     global diffmergeid parents nparents currenthunk
2422     global mergefilelist diffblocked mergefds
2423     global grouphunks grouplinestart grouplineend groupfilenum
2424
2425     set nfiles [llength $mergefilelist($diffmergeid)]
2426     while 1 {
2427         set fi $nfiles
2428         set lno 0
2429         # look for the earliest hunk
2430         foreach p $parents($diffmergeid) {
2431             set ids [list $diffmergeid $p]
2432             if {![info exists currenthunk($ids)]} return
2433             set i [lindex $currenthunk($ids) 0]
2434             set l [lindex $currenthunk($ids) 2]
2435             if {$i < $fi || ($i == $fi && $l < $lno)} {
2436                 set fi $i
2437                 set lno $l
2438                 set pi $p
2439             }
2440         }
2441
2442         if {$fi < $nfiles} {
2443             set ids [list $diffmergeid $pi]
2444             set hunk $currenthunk($ids)
2445             unset currenthunk($ids)
2446             if {$diffblocked($ids) > 0} {
2447                 fileevent $mergefds($ids) readable \
2448                     [list getmergediffline $mergefds($ids) $ids $diffmergeid]
2449             }
2450             set diffblocked($ids) 0
2451
2452             if {[info exists groupfilenum] && $groupfilenum == $fi
2453                 && $lno <= $grouplineend} {
2454                 # add this hunk to the pending group
2455                 lappend grouphunks($pi) $hunk
2456                 set endln [lindex $hunk 4]
2457                 if {$endln > $grouplineend} {
2458                     set grouplineend $endln
2459                 }
2460                 continue
2461             }
2462         }
2463
2464         # succeeding stuff doesn't belong in this group, so
2465         # process the group now
2466         if {[info exists groupfilenum]} {
2467             processgroup
2468             unset groupfilenum
2469             unset grouphunks
2470         }
2471
2472         if {$fi >= $nfiles} break
2473
2474         # start a new group
2475         set groupfilenum $fi
2476         set grouphunks($pi) [list $hunk]
2477         set grouplinestart $lno
2478         set grouplineend [lindex $hunk 4]
2479     }
2480 }
2481
2482 proc processgroup {} {
2483     global groupfilelast groupfilenum difffilestart
2484     global mergefilelist diffmergeid ctext filelines
2485     global parents diffmergeid diffoffset
2486     global grouphunks grouplinestart grouplineend nparents
2487     global mergemax
2488
2489     $ctext conf -state normal
2490     set id $diffmergeid
2491     set f $groupfilenum
2492     if {$groupfilelast != $f} {
2493         $ctext insert end "\n"
2494         set here [$ctext index "end - 1c"]
2495         set difffilestart($f) $here
2496         set mark fmark.[expr {$f + 1}]
2497         $ctext mark set $mark $here
2498         $ctext mark gravity $mark left
2499         set header [lindex $mergefilelist($id) $f]
2500         set l [expr {(78 - [string length $header]) / 2}]
2501         set pad [string range "----------------------------------------" 1 $l]
2502         $ctext insert end "$pad $header $pad\n" filesep
2503         set groupfilelast $f
2504         foreach p $parents($id) {
2505             set diffoffset($p) 0
2506         }
2507     }
2508
2509     $ctext insert end "@@" msep
2510     set nlines [expr {$grouplineend - $grouplinestart}]
2511     set events {}
2512     set pnum 0
2513     foreach p $parents($id) {
2514         set startline [expr {$grouplinestart + $diffoffset($p)}]
2515         set ol $startline
2516         set nl $grouplinestart
2517         if {[info exists grouphunks($p)]} {
2518             foreach h $grouphunks($p) {
2519                 set l [lindex $h 2]
2520                 if {$nl < $l} {
2521                     for {} {$nl < $l} {incr nl} {
2522                         set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2523                         incr ol
2524                     }
2525                 }
2526                 foreach chunk [lindex $h 5] {
2527                     if {[llength $chunk] == 2} {
2528                         set olc [lindex $chunk 0]
2529                         set nlc [lindex $chunk 1]
2530                         set nnl [expr {$nl + $nlc}]
2531                         lappend events [list $nl $nnl $pnum $olc $nlc]
2532                         incr ol $olc
2533                         set nl $nnl
2534                     } else {
2535                         incr ol [lindex $chunk 0]
2536                         incr nl [lindex $chunk 0]
2537                     }
2538                 }
2539             }
2540         }
2541         if {$nl < $grouplineend} {
2542             for {} {$nl < $grouplineend} {incr nl} {
2543                 set filelines($p,$f,$ol) $filelines($id,$f,$nl)
2544                 incr ol
2545             }
2546         }
2547         set nlines [expr {$ol - $startline}]
2548         $ctext insert end " -$startline,$nlines" msep
2549         incr pnum
2550     }
2551
2552     set nlines [expr {$grouplineend - $grouplinestart}]
2553     $ctext insert end " +$grouplinestart,$nlines @@\n" msep
2554
2555     set events [lsort -integer -index 0 $events]
2556     set nevents [llength $events]
2557     set nmerge $nparents($diffmergeid)
2558     set l $grouplinestart
2559     for {set i 0} {$i < $nevents} {set i $j} {
2560         set nl [lindex $events $i 0]
2561         while {$l < $nl} {
2562             $ctext insert end " $filelines($id,$f,$l)\n"
2563             incr l
2564         }
2565         set e [lindex $events $i]
2566         set enl [lindex $e 1]
2567         set j $i
2568         set active {}
2569         while 1 {
2570             set pnum [lindex $e 2]
2571             set olc [lindex $e 3]
2572             set nlc [lindex $e 4]
2573             if {![info exists delta($pnum)]} {
2574                 set delta($pnum) [expr {$olc - $nlc}]
2575                 lappend active $pnum
2576             } else {
2577                 incr delta($pnum) [expr {$olc - $nlc}]
2578             }
2579             if {[incr j] >= $nevents} break
2580             set e [lindex $events $j]
2581             if {[lindex $e 0] >= $enl} break
2582             if {[lindex $e 1] > $enl} {
2583                 set enl [lindex $e 1]
2584             }
2585         }
2586         set nlc [expr {$enl - $l}]
2587         set ncol mresult
2588         set bestpn -1
2589         if {[llength $active] == $nmerge - 1} {
2590             # no diff for one of the parents, i.e. it's identical
2591             for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2592                 if {![info exists delta($pnum)]} {
2593                     if {$pnum < $mergemax} {
2594                         lappend ncol m$pnum
2595                     } else {
2596                         lappend ncol mmax
2597                     }
2598                     break
2599                 }
2600             }
2601         } elseif {[llength $active] == $nmerge} {
2602             # all parents are different, see if one is very similar
2603             set bestsim 30
2604             for {set pnum 0} {$pnum < $nmerge} {incr pnum} {
2605                 set sim [similarity $pnum $l $nlc $f \
2606                              [lrange $events $i [expr {$j-1}]]]
2607                 if {$sim > $bestsim} {
2608                     set bestsim $sim
2609                     set bestpn $pnum
2610                 }
2611             }
2612             if {$bestpn >= 0} {
2613                 lappend ncol m$bestpn
2614             }
2615         }
2616         set pnum -1
2617         foreach p $parents($id) {
2618             incr pnum
2619             if {![info exists delta($pnum)] || $pnum == $bestpn} continue
2620             set olc [expr {$nlc + $delta($pnum)}]
2621             set ol [expr {$l + $diffoffset($p)}]
2622             incr diffoffset($p) $delta($pnum)
2623             unset delta($pnum)
2624             for {} {$olc > 0} {incr olc -1} {
2625                 $ctext insert end "-$filelines($p,$f,$ol)\n" m$pnum
2626                 incr ol
2627             }
2628         }
2629         set endl [expr {$l + $nlc}]
2630         if {$bestpn >= 0} {
2631             # show this pretty much as a normal diff
2632             set p [lindex $parents($id) $bestpn]
2633             set ol [expr {$l + $diffoffset($p)}]
2634             incr diffoffset($p) $delta($bestpn)
2635             unset delta($bestpn)
2636             for {set k $i} {$k < $j} {incr k} {
2637                 set e [lindex $events $k]
2638                 if {[lindex $e 2] != $bestpn} continue
2639                 set nl [lindex $e 0]
2640                 set ol [expr {$ol + $nl - $l}]
2641                 for {} {$l < $nl} {incr l} {
2642                     $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2643                 }
2644                 set c [lindex $e 3]
2645                 for {} {$c > 0} {incr c -1} {
2646                     $ctext insert end "-$filelines($p,$f,$ol)\n" m$bestpn
2647                     incr ol
2648                 }
2649                 set nl [lindex $e 1]
2650                 for {} {$l < $nl} {incr l} {
2651                     $ctext insert end "+$filelines($id,$f,$l)\n" mresult
2652                 }
2653             }
2654         }
2655         for {} {$l < $endl} {incr l} {
2656             $ctext insert end "+$filelines($id,$f,$l)\n" $ncol
2657         }
2658     }
2659     while {$l < $grouplineend} {
2660         $ctext insert end " $filelines($id,$f,$l)\n"
2661         incr l
2662     }
2663     $ctext conf -state disabled
2664 }
2665
2666 proc similarity {pnum l nlc f events} {
2667     global diffmergeid parents diffoffset filelines
2668
2669     set id $diffmergeid
2670     set p [lindex $parents($id) $pnum]
2671     set ol [expr {$l + $diffoffset($p)}]
2672     set endl [expr {$l + $nlc}]
2673     set same 0
2674     set diff 0
2675     foreach e $events {
2676         if {[lindex $e 2] != $pnum} continue
2677         set nl [lindex $e 0]
2678         set ol [expr {$ol + $nl - $l}]
2679         for {} {$l < $nl} {incr l} {
2680             incr same [string length $filelines($id,$f,$l)]
2681             incr same
2682         }
2683         set oc [lindex $e 3]
2684         for {} {$oc > 0} {incr oc -1} {
2685             incr diff [string length $filelines($p,$f,$ol)]
2686             incr diff
2687             incr ol
2688         }
2689         set nl [lindex $e 1]
2690         for {} {$l < $nl} {incr l} {
2691             incr diff [string length $filelines($id,$f,$l)]
2692             incr diff
2693         }
2694     }
2695     for {} {$l < $endl} {incr l} {
2696         incr same [string length $filelines($id,$f,$l)]
2697         incr same
2698     }
2699     if {$same == 0} {
2700         return 0
2701     }
2702     return [expr {200 * $same / (2 * $same + $diff)}]
2703 }
2704
2705 proc startdiff {ids} {
2706     global treediffs diffids treepending diffmergeid
2707
2708     set diffids $ids
2709     catch {unset diffmergeid}
2710     if {![info exists treediffs($ids)]} {
2711         if {![info exists treepending]} {
2712             gettreediffs $ids
2713         }
2714     } else {
2715         addtocflist $ids
2716     }
2717 }
2718
2719 proc addtocflist {ids} {
2720     global treediffs cflist
2721     foreach f $treediffs($ids) {
2722         $cflist insert end $f
2723     }
2724     getblobdiffs $ids
2725 }
2726
2727 proc gettreediffs {ids} {
2728     global treediff parents treepending
2729     set treepending $ids
2730     set treediff {}
2731     set id [lindex $ids 0]
2732     set p [lindex $ids 1]
2733     if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
2734     fconfigure $gdtf -blocking 0
2735     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2736 }
2737
2738 proc gettreediffline {gdtf ids} {
2739     global treediff treediffs treepending diffids diffmergeid
2740
2741     set n [gets $gdtf line]
2742     if {$n < 0} {
2743         if {![eof $gdtf]} return
2744         close $gdtf
2745         set treediffs($ids) $treediff
2746         unset treepending
2747         if {$ids != $diffids} {
2748             gettreediffs $diffids
2749         } else {
2750             if {[info exists diffmergeid]} {
2751                 contmergediff $ids
2752             } else {
2753                 addtocflist $ids
2754             }
2755         }
2756         return
2757     }
2758     set file [lindex $line 5]
2759     lappend treediff $file
2760 }
2761
2762 proc getblobdiffs {ids} {
2763     global diffopts blobdifffd diffids env curdifftag curtagstart
2764     global difffilestart nextupdate diffinhdr treediffs
2765
2766     set id [lindex $ids 0]
2767     set p [lindex $ids 1]
2768     set env(GIT_DIFF_OPTS) $diffopts
2769     set cmd [list | git-diff-tree -r -p -C $p $id]
2770     if {[catch {set bdf [open $cmd r]} err]} {
2771         puts "error getting diffs: $err"
2772         return
2773     }
2774     set diffinhdr 0
2775     fconfigure $bdf -blocking 0
2776     set blobdifffd($ids) $bdf
2777     set curdifftag Comments
2778     set curtagstart 0.0
2779     catch {unset difffilestart}
2780     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2781     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2782 }
2783
2784 proc getblobdiffline {bdf ids} {
2785     global diffids blobdifffd ctext curdifftag curtagstart
2786     global diffnexthead diffnextnote difffilestart
2787     global nextupdate diffinhdr treediffs
2788     global gaudydiff
2789
2790     set n [gets $bdf line]
2791     if {$n < 0} {
2792         if {[eof $bdf]} {
2793             close $bdf
2794             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2795                 $ctext tag add $curdifftag $curtagstart end
2796             }
2797         }
2798         return
2799     }
2800     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2801         return
2802     }
2803     $ctext conf -state normal
2804     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2805         # start of a new file
2806         $ctext insert end "\n"
2807         $ctext tag add $curdifftag $curtagstart end
2808         set curtagstart [$ctext index "end - 1c"]
2809         set header $newname
2810         set here [$ctext index "end - 1c"]
2811         set i [lsearch -exact $treediffs($diffids) $fname]
2812         if {$i >= 0} {
2813             set difffilestart($i) $here
2814             incr i
2815             $ctext mark set fmark.$i $here
2816             $ctext mark gravity fmark.$i left
2817         }
2818         if {$newname != $fname} {
2819             set i [lsearch -exact $treediffs($diffids) $newname]
2820             if {$i >= 0} {
2821                 set difffilestart($i) $here
2822                 incr i
2823                 $ctext mark set fmark.$i $here
2824                 $ctext mark gravity fmark.$i left
2825             }
2826         }
2827         set curdifftag "f:$fname"
2828         $ctext tag delete $curdifftag
2829         set l [expr {(78 - [string length $header]) / 2}]
2830         set pad [string range "----------------------------------------" 1 $l]
2831         $ctext insert end "$pad $header $pad\n" filesep
2832         set diffinhdr 1
2833     } elseif {[regexp {^(---|\+\+\+)} $line]} {
2834         set diffinhdr 0
2835     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2836                    $line match f1l f1c f2l f2c rest]} {
2837         if {$gaudydiff} {
2838             $ctext insert end "\t" hunksep
2839             $ctext insert end "    $f1l    " d0 "    $f2l    " d1
2840             $ctext insert end "    $rest \n" hunksep
2841         } else {
2842             $ctext insert end "$line\n" hunksep
2843         }
2844         set diffinhdr 0
2845     } else {
2846         set x [string range $line 0 0]
2847         if {$x == "-" || $x == "+"} {
2848             set tag [expr {$x == "+"}]
2849             if {$gaudydiff} {
2850                 set line [string range $line 1 end]
2851             }
2852             $ctext insert end "$line\n" d$tag
2853         } elseif {$x == " "} {
2854             if {$gaudydiff} {
2855                 set line [string range $line 1 end]
2856             }
2857             $ctext insert end "$line\n"
2858         } elseif {$diffinhdr || $x == "\\"} {
2859             # e.g. "\ No newline at end of file"
2860             $ctext insert end "$line\n" filesep
2861         } else {
2862             # Something else we don't recognize
2863             if {$curdifftag != "Comments"} {
2864                 $ctext insert end "\n"
2865                 $ctext tag add $curdifftag $curtagstart end
2866                 set curtagstart [$ctext index "end - 1c"]
2867                 set curdifftag Comments
2868             }
2869             $ctext insert end "$line\n" filesep
2870         }
2871     }
2872     $ctext conf -state disabled
2873     if {[clock clicks -milliseconds] >= $nextupdate} {
2874         incr nextupdate 100
2875         fileevent $bdf readable {}
2876         update
2877         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2878     }
2879 }
2880
2881 proc nextfile {} {
2882     global difffilestart ctext
2883     set here [$ctext index @0,0]
2884     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2885         if {[$ctext compare $difffilestart($i) > $here]} {
2886             if {![info exists pos]
2887                 || [$ctext compare $difffilestart($i) < $pos]} {
2888                 set pos $difffilestart($i)
2889             }
2890         }
2891     }
2892     if {[info exists pos]} {
2893         $ctext yview $pos
2894     }
2895 }
2896
2897 proc listboxsel {} {
2898     global ctext cflist currentid
2899     if {![info exists currentid]} return
2900     set sel [lsort [$cflist curselection]]
2901     if {$sel eq {}} return
2902     set first [lindex $sel 0]
2903     catch {$ctext yview fmark.$first}
2904 }
2905
2906 proc setcoords {} {
2907     global linespc charspc canvx0 canvy0 mainfont
2908     global xspc1 xspc2 lthickness
2909
2910     set linespc [font metrics $mainfont -linespace]
2911     set charspc [font measure $mainfont "m"]
2912     set canvy0 [expr 3 + 0.5 * $linespc]
2913     set canvx0 [expr 3 + 0.5 * $linespc]
2914     set lthickness [expr {int($linespc / 9) + 1}]
2915     set xspc1(0) $linespc
2916     set xspc2 $linespc
2917 }
2918
2919 proc redisplay {} {
2920     global stopped redisplaying phase
2921     if {$stopped > 1} return
2922     if {$phase == "getcommits"} return
2923     set redisplaying 1
2924     if {$phase == "drawgraph" || $phase == "incrdraw"} {
2925         set stopped 1
2926     } else {
2927         drawgraph
2928     }
2929 }
2930
2931 proc incrfont {inc} {
2932     global mainfont namefont textfont ctext canv phase
2933     global stopped entries
2934     unmarkmatches
2935     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2936     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2937     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2938     setcoords
2939     $ctext conf -font $textfont
2940     $ctext tag conf filesep -font [concat $textfont bold]
2941     foreach e $entries {
2942         $e conf -font $mainfont
2943     }
2944     if {$phase == "getcommits"} {
2945         $canv itemconf textitems -font $mainfont
2946     }
2947     redisplay
2948 }
2949
2950 proc clearsha1 {} {
2951     global sha1entry sha1string
2952     if {[string length $sha1string] == 40} {
2953         $sha1entry delete 0 end
2954     }
2955 }
2956
2957 proc sha1change {n1 n2 op} {
2958     global sha1string currentid sha1but
2959     if {$sha1string == {}
2960         || ([info exists currentid] && $sha1string == $currentid)} {
2961         set state disabled
2962     } else {
2963         set state normal
2964     }
2965     if {[$sha1but cget -state] == $state} return
2966     if {$state == "normal"} {
2967         $sha1but conf -state normal -relief raised -text "Goto: "
2968     } else {
2969         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2970     }
2971 }
2972
2973 proc gotocommit {} {
2974     global sha1string currentid idline tagids
2975     global lineid numcommits
2976
2977     if {$sha1string == {}
2978         || ([info exists currentid] && $sha1string == $currentid)} return
2979     if {[info exists tagids($sha1string)]} {
2980         set id $tagids($sha1string)
2981     } else {
2982         set id [string tolower $sha1string]
2983         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2984             set matches {}
2985             for {set l 0} {$l < $numcommits} {incr l} {
2986                 if {[string match $id* $lineid($l)]} {
2987                     lappend matches $lineid($l)
2988                 }
2989             }
2990             if {$matches ne {}} {
2991                 if {[llength $matches] > 1} {
2992                     error_popup "Short SHA1 id $id is ambiguous"
2993                     return
2994                 }
2995                 set id [lindex $matches 0]
2996             }
2997         }
2998     }
2999     if {[info exists idline($id)]} {
3000         selectline $idline($id) 1
3001         return
3002     }
3003     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3004         set type "SHA1 id"
3005     } else {
3006         set type "Tag"
3007     }
3008     error_popup "$type $sha1string is not known"
3009 }
3010
3011 proc lineenter {x y id} {
3012     global hoverx hovery hoverid hovertimer
3013     global commitinfo canv
3014
3015     if {![info exists commitinfo($id)]} return
3016     set hoverx $x
3017     set hovery $y
3018     set hoverid $id
3019     if {[info exists hovertimer]} {
3020         after cancel $hovertimer
3021     }
3022     set hovertimer [after 500 linehover]
3023     $canv delete hover
3024 }
3025
3026 proc linemotion {x y id} {
3027     global hoverx hovery hoverid hovertimer
3028
3029     if {[info exists hoverid] && $id == $hoverid} {
3030         set hoverx $x
3031         set hovery $y
3032         if {[info exists hovertimer]} {
3033             after cancel $hovertimer
3034         }
3035         set hovertimer [after 500 linehover]
3036     }
3037 }
3038
3039 proc lineleave {id} {
3040     global hoverid hovertimer canv
3041
3042     if {[info exists hoverid] && $id == $hoverid} {
3043         $canv delete hover
3044         if {[info exists hovertimer]} {
3045             after cancel $hovertimer
3046             unset hovertimer
3047         }
3048         unset hoverid
3049     }
3050 }
3051
3052 proc linehover {} {
3053     global hoverx hovery hoverid hovertimer
3054     global canv linespc lthickness
3055     global commitinfo mainfont
3056
3057     set text [lindex $commitinfo($hoverid) 0]
3058     set ymax [lindex [$canv cget -scrollregion] 3]
3059     if {$ymax == {}} return
3060     set yfrac [lindex [$canv yview] 0]
3061     set x [expr {$hoverx + 2 * $linespc}]
3062     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3063     set x0 [expr {$x - 2 * $lthickness}]
3064     set y0 [expr {$y - 2 * $lthickness}]
3065     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3066     set y1 [expr {$y + $linespc + 2 * $lthickness}]
3067     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3068                -fill \#ffff80 -outline black -width 1 -tags hover]
3069     $canv raise $t
3070     set t [$canv create text $x $y -anchor nw -text $text -tags hover]
3071     $canv raise $t
3072 }
3073
3074 proc lineclick {x y id isnew} {
3075     global ctext commitinfo children cflist canv
3076
3077     unmarkmatches
3078     unselectline
3079     if {$isnew} {
3080         addtohistory [list lineclick $x $x $id 0]
3081     }
3082     $canv delete hover
3083     # fill the details pane with info about this line
3084     $ctext conf -state normal
3085     $ctext delete 0.0 end
3086     $ctext tag conf link -foreground blue -underline 1
3087     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3088     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3089     $ctext insert end "Parent:\t"
3090     $ctext insert end $id [list link link0]
3091     $ctext tag bind link0 <1> [list selbyid $id]
3092     set info $commitinfo($id)
3093     $ctext insert end "\n\t[lindex $info 0]\n"
3094     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3095     $ctext insert end "\tDate:\t[lindex $info 2]\n"
3096     if {[info exists children($id)]} {
3097         $ctext insert end "\nChildren:"
3098         set i 0
3099         foreach child $children($id) {
3100             incr i
3101             set info $commitinfo($child)
3102             $ctext insert end "\n\t"
3103             $ctext insert end $child [list link link$i]
3104             $ctext tag bind link$i <1> [list selbyid $child]
3105             $ctext insert end "\n\t[lindex $info 0]"
3106             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3107             $ctext insert end "\n\tDate:\t[lindex $info 2]\n"
3108         }
3109     }
3110     $ctext conf -state disabled
3111
3112     $cflist delete 0 end
3113 }
3114
3115 proc selbyid {id} {
3116     global idline
3117     if {[info exists idline($id)]} {
3118         selectline $idline($id) 1
3119     }
3120 }
3121
3122 proc mstime {} {
3123     global startmstime
3124     if {![info exists startmstime]} {
3125         set startmstime [clock clicks -milliseconds]
3126     }
3127     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3128 }
3129
3130 proc rowmenu {x y id} {
3131     global rowctxmenu idline selectedline rowmenuid
3132
3133     if {![info exists selectedline] || $idline($id) eq $selectedline} {
3134         set state disabled
3135     } else {
3136         set state normal
3137     }
3138     $rowctxmenu entryconfigure 0 -state $state
3139     $rowctxmenu entryconfigure 1 -state $state
3140     $rowctxmenu entryconfigure 2 -state $state
3141     set rowmenuid $id
3142     tk_popup $rowctxmenu $x $y
3143 }
3144
3145 proc diffvssel {dirn} {
3146     global rowmenuid selectedline lineid
3147
3148     if {![info exists selectedline]} return
3149     if {$dirn} {
3150         set oldid $lineid($selectedline)
3151         set newid $rowmenuid
3152     } else {
3153         set oldid $rowmenuid
3154         set newid $lineid($selectedline)
3155     }
3156     addtohistory [list doseldiff $oldid $newid]
3157     doseldiff $oldid $newid
3158 }
3159
3160 proc doseldiff {oldid newid} {
3161     global ctext cflist
3162     global commitinfo
3163
3164     $ctext conf -state normal
3165     $ctext delete 0.0 end
3166     $ctext mark set fmark.0 0.0
3167     $ctext mark gravity fmark.0 left
3168     $cflist delete 0 end
3169     $cflist insert end "Top"
3170     $ctext insert end "From "
3171     $ctext tag conf link -foreground blue -underline 1
3172     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3173     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3174     $ctext tag bind link0 <1> [list selbyid $oldid]
3175     $ctext insert end $oldid [list link link0]
3176     $ctext insert end "\n     "
3177     $ctext insert end [lindex $commitinfo($oldid) 0]
3178     $ctext insert end "\n\nTo   "
3179     $ctext tag bind link1 <1> [list selbyid $newid]
3180     $ctext insert end $newid [list link link1]
3181     $ctext insert end "\n     "
3182     $ctext insert end [lindex $commitinfo($newid) 0]
3183     $ctext insert end "\n"
3184     $ctext conf -state disabled
3185     $ctext tag delete Comments
3186     $ctext tag remove found 1.0 end
3187     startdiff [list $newid $oldid]
3188 }
3189
3190 proc mkpatch {} {
3191     global rowmenuid currentid commitinfo patchtop patchnum
3192
3193     if {![info exists currentid]} return
3194     set oldid $currentid
3195     set oldhead [lindex $commitinfo($oldid) 0]
3196     set newid $rowmenuid
3197     set newhead [lindex $commitinfo($newid) 0]
3198     set top .patch
3199     set patchtop $top
3200     catch {destroy $top}
3201     toplevel $top
3202     label $top.title -text "Generate patch"
3203     grid $top.title - -pady 10
3204     label $top.from -text "From:"
3205     entry $top.fromsha1 -width 40 -relief flat
3206     $top.fromsha1 insert 0 $oldid
3207     $top.fromsha1 conf -state readonly
3208     grid $top.from $top.fromsha1 -sticky w
3209     entry $top.fromhead -width 60 -relief flat
3210     $top.fromhead insert 0 $oldhead
3211     $top.fromhead conf -state readonly
3212     grid x $top.fromhead -sticky w
3213     label $top.to -text "To:"
3214     entry $top.tosha1 -width 40 -relief flat
3215     $top.tosha1 insert 0 $newid
3216     $top.tosha1 conf -state readonly
3217     grid $top.to $top.tosha1 -sticky w
3218     entry $top.tohead -width 60 -relief flat
3219     $top.tohead insert 0 $newhead
3220     $top.tohead conf -state readonly
3221     grid x $top.tohead -sticky w
3222     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3223     grid $top.rev x -pady 10
3224     label $top.flab -text "Output file:"
3225     entry $top.fname -width 60
3226     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3227     incr patchnum
3228     grid $top.flab $top.fname -sticky w
3229     frame $top.buts
3230     button $top.buts.gen -text "Generate" -command mkpatchgo
3231     button $top.buts.can -text "Cancel" -command mkpatchcan
3232     grid $top.buts.gen $top.buts.can
3233     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3234     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3235     grid $top.buts - -pady 10 -sticky ew
3236     focus $top.fname
3237 }
3238
3239 proc mkpatchrev {} {
3240     global patchtop
3241
3242     set oldid [$patchtop.fromsha1 get]
3243     set oldhead [$patchtop.fromhead get]
3244     set newid [$patchtop.tosha1 get]
3245     set newhead [$patchtop.tohead get]
3246     foreach e [list fromsha1 fromhead tosha1 tohead] \
3247             v [list $newid $newhead $oldid $oldhead] {
3248         $patchtop.$e conf -state normal
3249         $patchtop.$e delete 0 end
3250         $patchtop.$e insert 0 $v
3251         $patchtop.$e conf -state readonly
3252     }
3253 }
3254
3255 proc mkpatchgo {} {
3256     global patchtop
3257
3258     set oldid [$patchtop.fromsha1 get]
3259     set newid [$patchtop.tosha1 get]
3260     set fname [$patchtop.fname get]
3261     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3262         error_popup "Error creating patch: $err"
3263     }
3264     catch {destroy $patchtop}
3265     unset patchtop
3266 }
3267
3268 proc mkpatchcan {} {
3269     global patchtop
3270
3271     catch {destroy $patchtop}
3272     unset patchtop
3273 }
3274
3275 proc mktag {} {
3276     global rowmenuid mktagtop commitinfo
3277
3278     set top .maketag
3279     set mktagtop $top
3280     catch {destroy $top}
3281     toplevel $top
3282     label $top.title -text "Create tag"
3283     grid $top.title - -pady 10
3284     label $top.id -text "ID:"
3285     entry $top.sha1 -width 40 -relief flat
3286     $top.sha1 insert 0 $rowmenuid
3287     $top.sha1 conf -state readonly
3288     grid $top.id $top.sha1 -sticky w
3289     entry $top.head -width 60 -relief flat
3290     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3291     $top.head conf -state readonly
3292     grid x $top.head -sticky w
3293     label $top.tlab -text "Tag name:"
3294     entry $top.tag -width 60
3295     grid $top.tlab $top.tag -sticky w
3296     frame $top.buts
3297     button $top.buts.gen -text "Create" -command mktaggo
3298     button $top.buts.can -text "Cancel" -command mktagcan
3299     grid $top.buts.gen $top.buts.can
3300     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3301     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3302     grid $top.buts - -pady 10 -sticky ew
3303     focus $top.tag
3304 }
3305
3306 proc domktag {} {
3307     global mktagtop env tagids idtags
3308     global idpos idline linehtag canv selectedline
3309
3310     set id [$mktagtop.sha1 get]
3311     set tag [$mktagtop.tag get]
3312     if {$tag == {}} {
3313         error_popup "No tag name specified"
3314         return
3315     }
3316     if {[info exists tagids($tag)]} {
3317         error_popup "Tag \"$tag\" already exists"
3318         return
3319     }
3320     if {[catch {
3321         set dir [gitdir]
3322         set fname [file join $dir "refs/tags" $tag]
3323         set f [open $fname w]
3324         puts $f $id
3325         close $f
3326     } err]} {
3327         error_popup "Error creating tag: $err"
3328         return
3329     }
3330
3331     set tagids($tag) $id
3332     lappend idtags($id) $tag
3333     $canv delete tag.$id
3334     set xt [eval drawtags $id $idpos($id)]
3335     $canv coords $linehtag($idline($id)) $xt [lindex $idpos($id) 2]
3336     if {[info exists selectedline] && $selectedline == $idline($id)} {
3337         selectline $selectedline 0
3338     }
3339 }
3340
3341 proc mktagcan {} {
3342     global mktagtop
3343
3344     catch {destroy $mktagtop}
3345     unset mktagtop
3346 }
3347
3348 proc mktaggo {} {
3349     domktag
3350     mktagcan
3351 }
3352
3353 proc writecommit {} {
3354     global rowmenuid wrcomtop commitinfo wrcomcmd
3355
3356     set top .writecommit
3357     set wrcomtop $top
3358     catch {destroy $top}
3359     toplevel $top
3360     label $top.title -text "Write commit to file"
3361     grid $top.title - -pady 10
3362     label $top.id -text "ID:"
3363     entry $top.sha1 -width 40 -relief flat
3364     $top.sha1 insert 0 $rowmenuid
3365     $top.sha1 conf -state readonly
3366     grid $top.id $top.sha1 -sticky w
3367     entry $top.head -width 60 -relief flat
3368     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3369     $top.head conf -state readonly
3370     grid x $top.head -sticky w
3371     label $top.clab -text "Command:"
3372     entry $top.cmd -width 60 -textvariable wrcomcmd
3373     grid $top.clab $top.cmd -sticky w -pady 10
3374     label $top.flab -text "Output file:"
3375     entry $top.fname -width 60
3376     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3377     grid $top.flab $top.fname -sticky w
3378     frame $top.buts
3379     button $top.buts.gen -text "Write" -command wrcomgo
3380     button $top.buts.can -text "Cancel" -command wrcomcan
3381     grid $top.buts.gen $top.buts.can
3382     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3383     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3384     grid $top.buts - -pady 10 -sticky ew
3385     focus $top.fname
3386 }
3387
3388 proc wrcomgo {} {
3389     global wrcomtop
3390
3391     set id [$wrcomtop.sha1 get]
3392     set cmd "echo $id | [$wrcomtop.cmd get]"
3393     set fname [$wrcomtop.fname get]
3394     if {[catch {exec sh -c $cmd >$fname &} err]} {
3395         error_popup "Error writing commit: $err"
3396     }
3397     catch {destroy $wrcomtop}
3398     unset wrcomtop
3399 }
3400
3401 proc wrcomcan {} {
3402     global wrcomtop
3403
3404     catch {destroy $wrcomtop}
3405     unset wrcomtop
3406 }
3407
3408 proc doquit {} {
3409     global stopped
3410     set stopped 100
3411     destroy .
3412 }
3413
3414 # defaults...
3415 set datemode 0
3416 set boldnames 0
3417 set diffopts "-U 5 -p"
3418 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3419
3420 set mainfont {Helvetica 9}
3421 set textfont {Courier 9}
3422 set findmergefiles 0
3423 set gaudydiff 0
3424 set maxgraphpct 50
3425 set maxwidth 16
3426
3427 set colors {green red blue magenta darkgrey brown orange}
3428
3429 catch {source ~/.gitk}
3430
3431 set namefont $mainfont
3432 if {$boldnames} {
3433     lappend namefont bold
3434 }
3435
3436 set revtreeargs {}
3437 foreach arg $argv {
3438     switch -regexp -- $arg {
3439         "^$" { }
3440         "^-b" { set boldnames 1 }
3441         "^-d" { set datemode 1 }
3442         default {
3443             lappend revtreeargs $arg
3444         }
3445     }
3446 }
3447
3448 set history {}
3449 set historyindex 0
3450
3451 set stopped 0
3452 set redisplaying 0
3453 set stuffsaved 0
3454 set patchnum 0
3455 setcoords
3456 makewindow
3457 readrefs
3458 getcommits $revtreeargs