gitk

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