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