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 1
 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 drawlineseg {id i wid} {
1187     global rowoffsets rowidlist idrowranges
1188     global canv colormap lthickness
1189
1190     set startrow [lindex $idrowranges($id) [expr {2 * $i}]]
1191     set row [lindex $idrowranges($id) [expr {2 * $i + 1}]]
1192     if {$startrow == $row} return
1193     assigncolor $id
1194     set coords {}
1195     set col [lsearch -exact [lindex $rowidlist $row] $id]
1196     if {$col < 0} {
1197         puts "oops: drawline: id $id not on row $row"
1198         return
1199     }
1200     set lasto {}
1201     set ns 0
1202     while {1} {
1203         set o [lindex $rowoffsets $row $col]
1204         if {$o eq {}} break
1205         if {$o ne $lasto} {
1206             # changing direction
1207             set x [xc $row $col]
1208             set y [yc $row]
1209             lappend coords $x $y
1210             set lasto $o
1211         }
1212         incr col $o
1213         incr row -1
1214     }
1215     if {$coords eq {}} return
1216     set last [expr {[llength $idrowranges($id)] / 2 - 1}]
1217     set arrow [expr {2 * ($i > 0) + ($i < $last)}]
1218     set arrow [lindex {none first last both} $arrow]
1219     set wid [expr {$wid * $lthickness}]
1220     set x [xc $row $col]
1221     set y [yc $row]
1222     lappend coords $x $y
1223     set t [$canv create line $coords -width $wid \
1224                -fill $colormap($id) -tags lines.$id -arrow $arrow]
1225     $canv lower $t
1226     bindline $t $id
1227 }
1228
1229 proc drawparentlinks {id row col olds wid} {
1230     global rowidlist canv colormap lthickness
1231
1232     set row2 [expr {$row + 1}]
1233     set x [xc $row $col]
1234     set y [yc $row]
1235     set y2 [yc $row2]
1236     set ids [lindex $rowidlist $row2]
1237     # rmx = right-most X coord used
1238     set rmx 0
1239     set wid [expr {$wid * $lthickness}]
1240     foreach p $olds {
1241         set i [lsearch -exact $ids $p]
1242         if {$i < 0} {
1243             puts "oops, parent $p of $id not in list"
1244             continue
1245         }
1246         assigncolor $p
1247         # should handle duplicated parents here...
1248         set coords [list $x $y]
1249         if {$i < $col - 1} {
1250             lappend coords [xc $row [expr {$i + 1}]] $y
1251         } elseif {$i > $col + 1} {
1252             lappend coords [xc $row [expr {$i - 1}]] $y
1253         }
1254         set x2 [xc $row2 $i]
1255         if {$x2 > $rmx} {
1256             set rmx $x2
1257         }
1258         lappend coords $x2 $y2
1259         set t [$canv create line $coords -width $wid \
1260                    -fill $colormap($p) -tags lines.$p]
1261         $canv lower $t
1262         bindline $t $p
1263     }
1264     return $rmx
1265 }
1266
1267 proc drawlines {id xtra} {
1268     global colormap canv
1269     global idrowranges idrangedrawn
1270     global children iddrawn commitrow rowidlist
1271
1272     $canv delete lines.$id
1273     set wid [expr {$xtra + 1}]
1274     set nr [expr {[llength $idrowranges($id)] / 2}]
1275     for {set i 0} {$i < $nr} {incr i} {
1276         if {[info exists idrangedrawn($id,$i)]} {
1277             drawlineseg $id $i $wid
1278         }
1279     }
1280     if {[info exists children($id)]} {
1281         foreach child $children($id) {
1282             if {[info exists iddrawn($child)]} {
1283                 set row $commitrow($child)
1284                 set col [lsearch -exact [lindex $rowidlist $row] $child]
1285                 if {$col >= 0} {
1286                     drawparentlinks $child $row $col [list $id] $wid
1287                 }
1288             }
1289         }
1290     }
1291 }
1292
1293 proc drawcmittext {id row col rmx} {
1294     global linespc canv canv2 canv3 canvy0
1295     global commitlisted commitinfo rowidlist
1296     global rowtextx idpos idtags idheads idotherrefs
1297     global linehtag linentag linedtag
1298     global mainfont namefont
1299
1300     set ofill [expr {[info exists commitlisted($id)]? "blue": "white"}]
1301     set x [xc $row $col]
1302     set y [yc $row]
1303     set orad [expr {$linespc / 3}]
1304     set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1305                [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1306                -fill $ofill -outline black -width 1]
1307     $canv raise $t
1308     $canv bind $t <1> {selcanvline {} %x %y}
1309     set xt [xc $row [llength [lindex $rowidlist $row]]]
1310     if {$xt < $rmx} {
1311         set xt $rmx
1312     }
1313     set rowtextx($row) $xt
1314     set idpos($id) [list $x $xt $y]
1315     if {[info exists idtags($id)] || [info exists idheads($id)]
1316         || [info exists idotherrefs($id)]} {
1317         set xt [drawtags $id $x $xt $y]
1318     }
1319     set headline [lindex $commitinfo($id) 0]
1320     set name [lindex $commitinfo($id) 1]
1321     set date [lindex $commitinfo($id) 2]
1322     set date [formatdate $date]
1323     set linehtag($row) [$canv create text $xt $y -anchor w \
1324                             -text $headline -font $mainfont ]
1325     $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1326     set linentag($row) [$canv2 create text 3 $y -anchor w \
1327                             -text $name -font $namefont]
1328     set linedtag($row) [$canv3 create text 3 $y -anchor w \
1329                             -text $date -font $mainfont]
1330 }
1331
1332 proc drawcmitrow {row} {
1333     global displayorder rowidlist
1334     global idrowranges idrangedrawn iddrawn
1335     global commitinfo commitlisted parents numcommits
1336     global commitdata
1337
1338     if {$row >= $numcommits} return
1339     foreach id [lindex $rowidlist $row] {
1340         if {![info exists idrowranges($id)]} continue
1341         set i -1
1342         foreach {s e} $idrowranges($id) {
1343             incr i
1344             if {$row < $s} continue
1345             if {$e eq {}} break
1346             if {$row <= $e} {
1347                 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1348                     drawlineseg $id $i 1
1349                     set idrangedrawn($id,$i) 1
1350                 }
1351                 break
1352             }
1353         }
1354     }
1355
1356     set id [lindex $displayorder $row]
1357     if {[info exists iddrawn($id)]} return
1358     set col [lsearch -exact [lindex $rowidlist $row] $id]
1359     if {$col < 0} {
1360         puts "oops, row $row id $id not in list"
1361         return
1362     }
1363     if {![info exists commitinfo($id)]} {
1364         getcommit $id $row
1365     }
1366     assigncolor $id
1367     if {[info exists commitlisted($id)] && [info exists parents($id)]
1368         && $parents($id) ne {}} {
1369         set rmx [drawparentlinks $id $row $col $parents($id) 1]
1370     } else {
1371         set rmx 0
1372     }
1373     drawcmittext $id $row $col $rmx
1374     set iddrawn($id) 1
1375 }
1376
1377 proc drawfrac {f0 f1} {
1378     global numcommits canv
1379     global linespc
1380
1381     set ymax [lindex [$canv cget -scrollregion] 3]
1382     if {$ymax eq {} || $ymax == 0} return
1383     set y0 [expr {int($f0 * $ymax)}]
1384     set row [expr {int(($y0 - 3) / $linespc) - 1}]
1385     if {$row < 0} {
1386         set row 0
1387     }
1388     set y1 [expr {int($f1 * $ymax)}]
1389     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1390     if {$endrow >= $numcommits} {
1391         set endrow [expr {$numcommits - 1}]
1392     }
1393     for {} {$row <= $endrow} {incr row} {
1394         drawcmitrow $row
1395     }
1396 }
1397
1398 proc drawvisible {} {
1399     global canv
1400     eval drawfrac [$canv yview]
1401 }
1402
1403 proc clear_display {} {
1404     global iddrawn idrangedrawn
1405
1406     allcanvs delete all
1407     catch {unset iddrawn}
1408     catch {unset idrangedrawn}
1409 }
1410
1411 proc assigncolor {id} {
1412     global colormap colors nextcolor
1413     global parents nparents children nchildren
1414     global cornercrossings crossings
1415
1416     if {[info exists colormap($id)]} return
1417     set ncolors [llength $colors]
1418     if {$nchildren($id) == 1} {
1419         set child [lindex $children($id) 0]
1420         if {[info exists colormap($child)]
1421             && $nparents($child) == 1} {
1422             set colormap($id) $colormap($child)
1423             return
1424         }
1425     }
1426     set badcolors {}
1427     if {[info exists cornercrossings($id)]} {
1428         foreach x $cornercrossings($id) {
1429             if {[info exists colormap($x)]
1430                 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1431                 lappend badcolors $colormap($x)
1432             }
1433         }
1434         if {[llength $badcolors] >= $ncolors} {
1435             set badcolors {}
1436         }
1437     }
1438     set origbad $badcolors
1439     if {[llength $badcolors] < $ncolors - 1} {
1440         if {[info exists crossings($id)]} {
1441             foreach x $crossings($id) {
1442                 if {[info exists colormap($x)]
1443                     && [lsearch -exact $badcolors $colormap($x)] < 0} {
1444                     lappend badcolors $colormap($x)
1445                 }
1446             }
1447             if {[llength $badcolors] >= $ncolors} {
1448                 set badcolors $origbad
1449             }
1450         }
1451         set origbad $badcolors
1452     }
1453     if {[llength $badcolors] < $ncolors - 1} {
1454         foreach child $children($id) {
1455             if {[info exists colormap($child)]
1456                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1457                 lappend badcolors $colormap($child)
1458             }
1459             if {[info exists parents($child)]} {
1460                 foreach p $parents($child) {
1461                     if {[info exists colormap($p)]
1462                         && [lsearch -exact $badcolors $colormap($p)] < 0} {
1463                         lappend badcolors $colormap($p)
1464                     }
1465                 }
1466             }
1467         }
1468         if {[llength $badcolors] >= $ncolors} {
1469             set badcolors $origbad
1470         }
1471     }
1472     for {set i 0} {$i <= $ncolors} {incr i} {
1473         set c [lindex $colors $nextcolor]
1474         if {[incr nextcolor] >= $ncolors} {
1475             set nextcolor 0
1476         }
1477         if {[lsearch -exact $badcolors $c]} break
1478     }
1479     set colormap($id) $c
1480 }
1481
1482 proc bindline {t id} {
1483     global canv
1484
1485     $canv bind $t <Enter> "lineenter %x %y $id"
1486     $canv bind $t <Motion> "linemotion %x %y $id"
1487     $canv bind $t <Leave> "lineleave $id"
1488     $canv bind $t <Button-1> "lineclick %x %y $id 1"
1489 }
1490
1491 proc drawtags {id x xt y1} {
1492     global idtags idheads idotherrefs
1493     global linespc lthickness
1494     global canv mainfont commitrow rowtextx
1495
1496     set marks {}
1497     set ntags 0
1498     set nheads 0
1499     if {[info exists idtags($id)]} {
1500         set marks $idtags($id)
1501         set ntags [llength $marks]
1502     }
1503     if {[info exists idheads($id)]} {
1504         set marks [concat $marks $idheads($id)]
1505         set nheads [llength $idheads($id)]
1506     }
1507     if {[info exists idotherrefs($id)]} {
1508         set marks [concat $marks $idotherrefs($id)]
1509     }
1510     if {$marks eq {}} {
1511         return $xt
1512     }
1513
1514     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1515     set yt [expr {$y1 - 0.5 * $linespc}]
1516     set yb [expr {$yt + $linespc - 1}]
1517     set xvals {}
1518     set wvals {}
1519     foreach tag $marks {
1520         set wid [font measure $mainfont $tag]
1521         lappend xvals $xt
1522         lappend wvals $wid
1523         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1524     }
1525     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1526                -width $lthickness -fill black -tags tag.$id]
1527     $canv lower $t
1528     foreach tag $marks x $xvals wid $wvals {
1529         set xl [expr {$x + $delta}]
1530         set xr [expr {$x + $delta + $wid + $lthickness}]
1531         if {[incr ntags -1] >= 0} {
1532             # draw a tag
1533             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1534                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1535                        -width 1 -outline black -fill yellow -tags tag.$id]
1536             $canv bind $t <1> [list showtag $tag 1]
1537             set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1538         } else {
1539             # draw a head or other ref
1540             if {[incr nheads -1] >= 0} {
1541                 set col green
1542             } else {
1543                 set col "#ddddff"
1544             }
1545             set xl [expr {$xl - $delta/2}]
1546             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1547                 -width 1 -outline black -fill $col -tags tag.$id
1548         }
1549         set t [$canv create text $xl $y1 -anchor w -text $tag \
1550                    -font $mainfont -tags tag.$id]
1551         if {$ntags >= 0} {
1552             $canv bind $t <1> [list showtag $tag 1]
1553         }
1554     }
1555     return $xt
1556 }
1557
1558 proc checkcrossings {row endrow} {
1559     global displayorder parents rowidlist
1560
1561     for {} {$row < $endrow} {incr row} {
1562         set id [lindex $displayorder $row]
1563         set i [lsearch -exact [lindex $rowidlist $row] $id]
1564         if {$i < 0} continue
1565         set idlist [lindex $rowidlist [expr {$row+1}]]
1566         foreach p $parents($id) {
1567             set j [lsearch -exact $idlist $p]
1568             if {$j > 0} {
1569                 if {$j < $i - 1} {
1570                     notecrossings $row $p $j $i [expr {$j+1}]
1571                 } elseif {$j > $i + 1} {
1572                     notecrossings $row $p $i $j [expr {$j-1}]
1573                 }
1574             }
1575         }
1576     }
1577 }
1578
1579 proc notecrossings {row id lo hi corner} {
1580     global rowidlist crossings cornercrossings
1581
1582     for {set i $lo} {[incr i] < $hi} {} {
1583         set p [lindex [lindex $rowidlist $row] $i]
1584         if {$p == {}} continue
1585         if {$i == $corner} {
1586             if {![info exists cornercrossings($id)]
1587                 || [lsearch -exact $cornercrossings($id) $p] < 0} {
1588                 lappend cornercrossings($id) $p
1589             }
1590             if {![info exists cornercrossings($p)]
1591                 || [lsearch -exact $cornercrossings($p) $id] < 0} {
1592                 lappend cornercrossings($p) $id
1593             }
1594         } else {
1595             if {![info exists crossings($id)]
1596                 || [lsearch -exact $crossings($id) $p] < 0} {
1597                 lappend crossings($id) $p
1598             }
1599             if {![info exists crossings($p)]
1600                 || [lsearch -exact $crossings($p) $id] < 0} {
1601                 lappend crossings($p) $id
1602             }
1603         }
1604     }
1605 }
1606
1607 proc xcoord {i level ln} {
1608     global canvx0 xspc1 xspc2
1609
1610     set x [expr {$canvx0 + $i * $xspc1($ln)}]
1611     if {$i > 0 && $i == $level} {
1612         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1613     } elseif {$i > $level} {
1614         set x [expr {$x + $xspc2 - $xspc1($ln)}]
1615     }
1616     return $x
1617 }
1618
1619 proc finishcommits {} {
1620     global commitidx phase
1621     global canv mainfont ctext maincursor textcursor
1622
1623     if {$commitidx > 0} {
1624         drawrest
1625     } else {
1626         $canv delete all
1627         $canv create text 3 3 -anchor nw -text "No commits selected" \
1628             -font $mainfont -tags textitems
1629     }
1630     . config -cursor $maincursor
1631     settextcursor $textcursor
1632     set phase {}
1633 }
1634
1635 # Don't change the text pane cursor if it is currently the hand cursor,
1636 # showing that we are over a sha1 ID link.
1637 proc settextcursor {c} {
1638     global ctext curtextcursor
1639
1640     if {[$ctext cget -cursor] == $curtextcursor} {
1641         $ctext config -cursor $c
1642     }
1643     set curtextcursor $c
1644 }
1645
1646 proc drawrest {} {
1647     global phase
1648     global numcommits
1649     global startmsecs
1650     global canvy0 numcommits linespc
1651     global rowlaidout commitidx
1652
1653     set row $rowlaidout
1654     layoutrows $rowlaidout $commitidx 1
1655     layouttail
1656     optimize_rows $row 0 $commitidx
1657     showstuff $commitidx
1658
1659     set phase {}
1660     set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
1661     #puts "overall $drawmsecs ms for $numcommits commits"
1662 }
1663
1664 proc findmatches {f} {
1665     global findtype foundstring foundstrlen
1666     if {$findtype == "Regexp"} {
1667         set matches [regexp -indices -all -inline $foundstring $f]
1668     } else {
1669         if {$findtype == "IgnCase"} {
1670             set str [string tolower $f]
1671         } else {
1672             set str $f
1673         }
1674         set matches {}
1675         set i 0
1676         while {[set j [string first $foundstring $str $i]] >= 0} {
1677             lappend matches [list $j [expr {$j+$foundstrlen-1}]]
1678             set i [expr {$j + $foundstrlen}]
1679         }
1680     }
1681     return $matches
1682 }
1683
1684 proc dofind {} {
1685     global findtype findloc findstring markedmatches commitinfo
1686     global numcommits displayorder linehtag linentag linedtag
1687     global mainfont namefont canv canv2 canv3 selectedline
1688     global matchinglines foundstring foundstrlen matchstring
1689     global commitdata
1690
1691     stopfindproc
1692     unmarkmatches
1693     focus .
1694     set matchinglines {}
1695     if {$findloc == "Pickaxe"} {
1696         findpatches
1697         return
1698     }
1699     if {$findtype == "IgnCase"} {
1700         set foundstring [string tolower $findstring]
1701     } else {
1702         set foundstring $findstring
1703     }
1704     set foundstrlen [string length $findstring]
1705     if {$foundstrlen == 0} return
1706     regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
1707     set matchstring "*$matchstring*"
1708     if {$findloc == "Files"} {
1709         findfiles
1710         return
1711     }
1712     if {![info exists selectedline]} {
1713         set oldsel -1
1714     } else {
1715         set oldsel $selectedline
1716     }
1717     set didsel 0
1718     set fldtypes {Headline Author Date Committer CDate Comment}
1719     set l -1
1720     foreach d $commitdata {
1721         incr l
1722         if {$findtype == "Regexp"} {
1723             set doesmatch [regexp $foundstring $d]
1724         } elseif {$findtype == "IgnCase"} {
1725             set doesmatch [string match -nocase $matchstring $d]
1726         } else {
1727             set doesmatch [string match $matchstring $d]
1728         }
1729         if {!$doesmatch} continue
1730         set id [lindex $displayorder $l]
1731         if {![info exists commitinfo($id)]} {
1732             getcommit $id $l
1733         }
1734         set info $commitinfo($id)
1735         set doesmatch 0
1736         foreach f $info ty $fldtypes {
1737             if {$findloc != "All fields" && $findloc != $ty} {
1738                 continue
1739             }
1740             set matches [findmatches $f]
1741             if {$matches == {}} continue
1742             set doesmatch 1
1743             if {$ty == "Headline"} {
1744                 drawcmitrow $l
1745                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
1746             } elseif {$ty == "Author"} {
1747                 drawcmitrow $l
1748                 markmatches $canv2 $l $f $linentag($l) $matches $namefont
1749             } elseif {$ty == "Date"} {
1750                 drawcmitrow $l
1751                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
1752             }
1753         }
1754         if {$doesmatch} {
1755             lappend matchinglines $l
1756             if {!$didsel && $l > $oldsel} {
1757                 findselectline $l
1758                 set didsel 1
1759             }
1760         }
1761     }
1762     if {$matchinglines == {}} {
1763         bell
1764     } elseif {!$didsel} {
1765         findselectline [lindex $matchinglines 0]
1766     }
1767 }
1768
1769 proc findselectline {l} {
1770     global findloc commentend ctext
1771     selectline $l 1
1772     if {$findloc == "All fields" || $findloc == "Comments"} {
1773         # highlight the matches in the comments
1774         set f [$ctext get 1.0 $commentend]
1775         set matches [findmatches $f]
1776         foreach match $matches {
1777             set start [lindex $match 0]
1778             set end [expr {[lindex $match 1] + 1}]
1779             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
1780         }
1781     }
1782 }
1783
1784 proc findnext {restart} {
1785     global matchinglines selectedline
1786     if {![info exists matchinglines]} {
1787         if {$restart} {
1788             dofind
1789         }
1790         return
1791     }
1792     if {![info exists selectedline]} return
1793     foreach l $matchinglines {
1794         if {$l > $selectedline} {
1795             findselectline $l
1796             return
1797         }
1798     }
1799     bell
1800 }
1801
1802 proc findprev {} {
1803     global matchinglines selectedline
1804     if {![info exists matchinglines]} {
1805         dofind
1806         return
1807     }
1808     if {![info exists selectedline]} return
1809     set prev {}
1810     foreach l $matchinglines {
1811         if {$l >= $selectedline} break
1812         set prev $l
1813     }
1814     if {$prev != {}} {
1815         findselectline $prev
1816     } else {
1817         bell
1818     }
1819 }
1820
1821 proc findlocchange {name ix op} {
1822     global findloc findtype findtypemenu
1823     if {$findloc == "Pickaxe"} {
1824         set findtype Exact
1825         set state disabled
1826     } else {
1827         set state normal
1828     }
1829     $findtypemenu entryconf 1 -state $state
1830     $findtypemenu entryconf 2 -state $state
1831 }
1832
1833 proc stopfindproc {{done 0}} {
1834     global findprocpid findprocfile findids
1835     global ctext findoldcursor phase maincursor textcursor
1836     global findinprogress
1837
1838     catch {unset findids}
1839     if {[info exists findprocpid]} {
1840         if {!$done} {
1841             catch {exec kill $findprocpid}
1842         }
1843         catch {close $findprocfile}
1844         unset findprocpid
1845     }
1846     if {[info exists findinprogress]} {
1847         unset findinprogress
1848         if {$phase != "incrdraw"} {
1849             . config -cursor $maincursor
1850             settextcursor $textcursor
1851         }
1852     }
1853 }
1854
1855 proc findpatches {} {
1856     global findstring selectedline numcommits
1857     global findprocpid findprocfile
1858     global finddidsel ctext displayorder findinprogress
1859     global findinsertpos
1860
1861     if {$numcommits == 0} return
1862
1863     # make a list of all the ids to search, starting at the one
1864     # after the selected line (if any)
1865     if {[info exists selectedline]} {
1866         set l $selectedline
1867     } else {
1868         set l -1
1869     }
1870     set inputids {}
1871     for {set i 0} {$i < $numcommits} {incr i} {
1872         if {[incr l] >= $numcommits} {
1873             set l 0
1874         }
1875         append inputids [lindex $displayorder $l] "\n"
1876     }
1877
1878     if {[catch {
1879         set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
1880                          << $inputids] r]
1881     } err]} {
1882         error_popup "Error starting search process: $err"
1883         return
1884     }
1885
1886     set findinsertpos end
1887     set findprocfile $f
1888     set findprocpid [pid $f]
1889     fconfigure $f -blocking 0
1890     fileevent $f readable readfindproc
1891     set finddidsel 0
1892     . config -cursor watch
1893     settextcursor watch
1894     set findinprogress 1
1895 }
1896
1897 proc readfindproc {} {
1898     global findprocfile finddidsel
1899     global commitrow matchinglines findinsertpos
1900
1901     set n [gets $findprocfile line]
1902     if {$n < 0} {
1903         if {[eof $findprocfile]} {
1904             stopfindproc 1
1905             if {!$finddidsel} {
1906                 bell
1907             }
1908         }
1909         return
1910     }
1911     if {![regexp {^[0-9a-f]{40}} $line id]} {
1912         error_popup "Can't parse git-diff-tree output: $line"
1913         stopfindproc
1914         return
1915     }
1916     if {![info exists commitrow($id)]} {
1917         puts stderr "spurious id: $id"
1918         return
1919     }
1920     set l $commitrow($id)
1921     insertmatch $l $id
1922 }
1923
1924 proc insertmatch {l id} {
1925     global matchinglines findinsertpos finddidsel
1926
1927     if {$findinsertpos == "end"} {
1928         if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
1929             set matchinglines [linsert $matchinglines 0 $l]
1930             set findinsertpos 1
1931         } else {
1932             lappend matchinglines $l
1933         }
1934     } else {
1935         set matchinglines [linsert $matchinglines $findinsertpos $l]
1936         incr findinsertpos
1937     }
1938     markheadline $l $id
1939     if {!$finddidsel} {
1940         findselectline $l
1941         set finddidsel 1
1942     }
1943 }
1944
1945 proc findfiles {} {
1946     global selectedline numcommits displayorder ctext
1947     global ffileline finddidsel parents nparents
1948     global findinprogress findstartline findinsertpos
1949     global treediffs fdiffid fdiffsneeded fdiffpos
1950     global findmergefiles
1951
1952     if {$numcommits == 0} return
1953
1954     if {[info exists selectedline]} {
1955         set l [expr {$selectedline + 1}]
1956     } else {
1957         set l 0
1958     }
1959     set ffileline $l
1960     set findstartline $l
1961     set diffsneeded {}
1962     set fdiffsneeded {}
1963     while 1 {
1964         set id [lindex $displayorder $l]
1965         if {$findmergefiles || $nparents($id) == 1} {
1966             if {![info exists treediffs($id)]} {
1967                 append diffsneeded "$id\n"
1968                 lappend fdiffsneeded $id
1969             }
1970         }
1971         if {[incr l] >= $numcommits} {
1972             set l 0
1973         }
1974         if {$l == $findstartline} break
1975     }
1976
1977     # start off a git-diff-tree process if needed
1978     if {$diffsneeded ne {}} {
1979         if {[catch {
1980             set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
1981         } err ]} {
1982             error_popup "Error starting search process: $err"
1983             return
1984         }
1985         catch {unset fdiffid}
1986         set fdiffpos 0
1987         fconfigure $df -blocking 0
1988         fileevent $df readable [list readfilediffs $df]
1989     }
1990
1991     set finddidsel 0
1992     set findinsertpos end
1993     set id [lindex $displayorder $l]
1994     . config -cursor watch
1995     settextcursor watch
1996     set findinprogress 1
1997     findcont $id
1998     update
1999 }
2000
2001 proc readfilediffs {df} {
2002     global findid fdiffid fdiffs
2003
2004     set n [gets $df line]
2005     if {$n < 0} {
2006         if {[eof $df]} {
2007             donefilediff
2008             if {[catch {close $df} err]} {
2009                 stopfindproc
2010                 bell
2011                 error_popup "Error in git-diff-tree: $err"
2012             } elseif {[info exists findid]} {
2013                 set id $findid
2014                 stopfindproc
2015                 bell
2016                 error_popup "Couldn't find diffs for $id"
2017             }
2018         }
2019         return
2020     }
2021     if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2022         # start of a new string of diffs
2023         donefilediff
2024         set fdiffid $id
2025         set fdiffs {}
2026     } elseif {[string match ":*" $line]} {
2027         lappend fdiffs [lindex $line 5]
2028     }
2029 }
2030
2031 proc donefilediff {} {
2032     global fdiffid fdiffs treediffs findid
2033     global fdiffsneeded fdiffpos
2034
2035     if {[info exists fdiffid]} {
2036         while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2037                && $fdiffpos < [llength $fdiffsneeded]} {
2038             # git-diff-tree doesn't output anything for a commit
2039             # which doesn't change anything
2040             set nullid [lindex $fdiffsneeded $fdiffpos]
2041             set treediffs($nullid) {}
2042             if {[info exists findid] && $nullid eq $findid} {
2043                 unset findid
2044                 findcont $nullid
2045             }
2046             incr fdiffpos
2047         }
2048         incr fdiffpos
2049
2050         if {![info exists treediffs($fdiffid)]} {
2051             set treediffs($fdiffid) $fdiffs
2052         }
2053         if {[info exists findid] && $fdiffid eq $findid} {
2054             unset findid
2055             findcont $fdiffid
2056         }
2057     }
2058 }
2059
2060 proc findcont {id} {
2061     global findid treediffs parents nparents
2062     global ffileline findstartline finddidsel
2063     global displayorder numcommits matchinglines findinprogress
2064     global findmergefiles
2065
2066     set l $ffileline
2067     while 1 {
2068         if {$findmergefiles || $nparents($id) == 1} {
2069             if {![info exists treediffs($id)]} {
2070                 set findid $id
2071                 set ffileline $l
2072                 return
2073             }
2074             set doesmatch 0
2075             foreach f $treediffs($id) {
2076                 set x [findmatches $f]
2077                 if {$x != {}} {
2078                     set doesmatch 1
2079                     break
2080                 }
2081             }
2082             if {$doesmatch} {
2083                 insertmatch $l $id
2084             }
2085         }
2086         if {[incr l] >= $numcommits} {
2087             set l 0
2088         }
2089         if {$l == $findstartline} break
2090         set id [lindex $displayorder $l]
2091     }
2092     stopfindproc
2093     if {!$finddidsel} {
2094         bell
2095     }
2096 }
2097
2098 # mark a commit as matching by putting a yellow background
2099 # behind the headline
2100 proc markheadline {l id} {
2101     global canv mainfont linehtag
2102
2103     drawcmitrow $l
2104     set bbox [$canv bbox $linehtag($l)]
2105     set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2106     $canv lower $t
2107 }
2108
2109 # mark the bits of a headline, author or date that match a find string
2110 proc markmatches {canv l str tag matches font} {
2111     set bbox [$canv bbox $tag]
2112     set x0 [lindex $bbox 0]
2113     set y0 [lindex $bbox 1]
2114     set y1 [lindex $bbox 3]
2115     foreach match $matches {
2116         set start [lindex $match 0]
2117         set end [lindex $match 1]
2118         if {$start > $end} continue
2119         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2120         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2121         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2122                    [expr {$x0+$xlen+2}] $y1 \
2123                    -outline {} -tags matches -fill yellow]
2124         $canv lower $t
2125     }
2126 }
2127
2128 proc unmarkmatches {} {
2129     global matchinglines findids
2130     allcanvs delete matches
2131     catch {unset matchinglines}
2132     catch {unset findids}
2133 }
2134
2135 proc selcanvline {w x y} {
2136     global canv canvy0 ctext linespc
2137     global rowtextx
2138     set ymax [lindex [$canv cget -scrollregion] 3]
2139     if {$ymax == {}} return
2140     set yfrac [lindex [$canv yview] 0]
2141     set y [expr {$y + $yfrac * $ymax}]
2142     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2143     if {$l < 0} {
2144         set l 0
2145     }
2146     if {$w eq $canv} {
2147         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2148     }
2149     unmarkmatches
2150     selectline $l 1
2151 }
2152
2153 proc commit_descriptor {p} {
2154     global commitinfo
2155     set l "..."
2156     if {[info exists commitinfo($p)]} {
2157         set l [lindex $commitinfo($p) 0]
2158     }
2159     return "$p ($l)"
2160 }
2161
2162 # append some text to the ctext widget, and make any SHA1 ID
2163 # that we know about be a clickable link.
2164 proc appendwithlinks {text} {
2165     global ctext commitrow linknum
2166
2167     set start [$ctext index "end - 1c"]
2168     $ctext insert end $text
2169     $ctext insert end "\n"
2170     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2171     foreach l $links {
2172         set s [lindex $l 0]
2173         set e [lindex $l 1]
2174         set linkid [string range $text $s $e]
2175         if {![info exists commitrow($linkid)]} continue
2176         incr e
2177         $ctext tag add link "$start + $s c" "$start + $e c"
2178         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2179         $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2180         incr linknum
2181     }
2182     $ctext tag conf link -foreground blue -underline 1
2183     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2184     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2185 }
2186
2187 proc selectline {l isnew} {
2188     global canv canv2 canv3 ctext commitinfo selectedline
2189     global displayorder linehtag linentag linedtag
2190     global canvy0 linespc parents nparents children
2191     global cflist currentid sha1entry
2192     global commentend idtags linknum
2193     global mergemax numcommits
2194
2195     $canv delete hover
2196     normalline
2197     if {$l < 0 || $l >= $numcommits} return
2198     set y [expr {$canvy0 + $l * $linespc}]
2199     set ymax [lindex [$canv cget -scrollregion] 3]
2200     set ytop [expr {$y - $linespc - 1}]
2201     set ybot [expr {$y + $linespc + 1}]
2202     set wnow [$canv yview]
2203     set wtop [expr {[lindex $wnow 0] * $ymax}]
2204     set wbot [expr {[lindex $wnow 1] * $ymax}]
2205     set wh [expr {$wbot - $wtop}]
2206     set newtop $wtop
2207     if {$ytop < $wtop} {
2208         if {$ybot < $wtop} {
2209             set newtop [expr {$y - $wh / 2.0}]
2210         } else {
2211             set newtop $ytop
2212             if {$newtop > $wtop - $linespc} {
2213                 set newtop [expr {$wtop - $linespc}]
2214             }
2215         }
2216     } elseif {$ybot > $wbot} {
2217         if {$ytop > $wbot} {
2218             set newtop [expr {$y - $wh / 2.0}]
2219         } else {
2220             set newtop [expr {$ybot - $wh}]
2221             if {$newtop < $wtop + $linespc} {
2222                 set newtop [expr {$wtop + $linespc}]
2223             }
2224         }
2225     }
2226     if {$newtop != $wtop} {
2227         if {$newtop < 0} {
2228             set newtop 0
2229         }
2230         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2231         drawvisible
2232     }
2233
2234     if {![info exists linehtag($l)]} return
2235     $canv delete secsel
2236     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2237                -tags secsel -fill [$canv cget -selectbackground]]
2238     $canv lower $t
2239     $canv2 delete secsel
2240     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2241                -tags secsel -fill [$canv2 cget -selectbackground]]
2242     $canv2 lower $t
2243     $canv3 delete secsel
2244     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2245                -tags secsel -fill [$canv3 cget -selectbackground]]
2246     $canv3 lower $t
2247
2248     if {$isnew} {
2249         addtohistory [list selectline $l 0]
2250     }
2251
2252     set selectedline $l
2253
2254     set id [lindex $displayorder $l]
2255     set currentid $id
2256     $sha1entry delete 0 end
2257     $sha1entry insert 0 $id
2258     $sha1entry selection from 0
2259     $sha1entry selection to end
2260
2261     $ctext conf -state normal
2262     $ctext delete 0.0 end
2263     set linknum 0
2264     $ctext mark set fmark.0 0.0
2265     $ctext mark gravity fmark.0 left
2266     set info $commitinfo($id)
2267     set date [formatdate [lindex $info 2]]
2268     $ctext insert end "Author: [lindex $info 1]  $date\n"
2269     set date [formatdate [lindex $info 4]]
2270     $ctext insert end "Committer: [lindex $info 3]  $date\n"
2271     if {[info exists idtags($id)]} {
2272         $ctext insert end "Tags:"
2273         foreach tag $idtags($id) {
2274             $ctext insert end " $tag"
2275         }
2276         $ctext insert end "\n"
2277     }
2278
2279     set comment {}
2280     if {$nparents($id) > 1} {
2281         set np 0
2282         foreach p $parents($id) {
2283             if {$np >= $mergemax} {
2284                 set tag mmax
2285             } else {
2286                 set tag m$np
2287             }
2288             $ctext insert end "Parent: " $tag
2289             appendwithlinks [commit_descriptor $p]
2290             incr np
2291         }
2292     } else {
2293         if {[info exists parents($id)]} {
2294             foreach p $parents($id) {
2295                 append comment "Parent: [commit_descriptor $p]\n"
2296             }
2297         }
2298     }
2299
2300     if {[info exists children($id)]} {
2301         foreach c $children($id) {
2302             append comment "Child:  [commit_descriptor $c]\n"
2303         }
2304     }
2305     append comment "\n"
2306     append comment [lindex $info 5]
2307
2308     # make anything that looks like a SHA1 ID be a clickable link
2309     appendwithlinks $comment
2310
2311     $ctext tag delete Comments
2312     $ctext tag remove found 1.0 end
2313     $ctext conf -state disabled
2314     set commentend [$ctext index "end - 1c"]
2315
2316     $cflist delete 0 end
2317     $cflist insert end "Comments"
2318     if {$nparents($id) == 1} {
2319         startdiff $id
2320     } elseif {$nparents($id) > 1} {
2321         mergediff $id
2322     }
2323 }
2324
2325 proc selnextline {dir} {
2326     global selectedline
2327     if {![info exists selectedline]} return
2328     set l [expr {$selectedline + $dir}]
2329     unmarkmatches
2330     selectline $l 1
2331 }
2332
2333 proc unselectline {} {
2334     global selectedline
2335
2336     catch {unset selectedline}
2337     allcanvs delete secsel
2338 }
2339
2340 proc addtohistory {cmd} {
2341     global history historyindex
2342
2343     if {$historyindex > 0
2344         && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2345         return
2346     }
2347
2348     if {$historyindex < [llength $history]} {
2349         set history [lreplace $history $historyindex end $cmd]
2350     } else {
2351         lappend history $cmd
2352     }
2353     incr historyindex
2354     if {$historyindex > 1} {
2355         .ctop.top.bar.leftbut conf -state normal
2356     } else {
2357         .ctop.top.bar.leftbut conf -state disabled
2358     }
2359     .ctop.top.bar.rightbut conf -state disabled
2360 }
2361
2362 proc goback {} {
2363     global history historyindex
2364
2365     if {$historyindex > 1} {
2366         incr historyindex -1
2367         set cmd [lindex $history [expr {$historyindex - 1}]]
2368         eval $cmd
2369         .ctop.top.bar.rightbut conf -state normal
2370     }
2371     if {$historyindex <= 1} {
2372         .ctop.top.bar.leftbut conf -state disabled
2373     }
2374 }
2375
2376 proc goforw {} {
2377     global history historyindex
2378
2379     if {$historyindex < [llength $history]} {
2380         set cmd [lindex $history $historyindex]
2381         incr historyindex
2382         eval $cmd
2383         .ctop.top.bar.leftbut conf -state normal
2384     }
2385     if {$historyindex >= [llength $history]} {
2386         .ctop.top.bar.rightbut conf -state disabled
2387     }
2388 }
2389
2390 proc mergediff {id} {
2391     global parents diffmergeid diffopts mdifffd
2392     global difffilestart
2393
2394     set diffmergeid $id
2395     catch {unset difffilestart}
2396     # this doesn't seem to actually affect anything...
2397     set env(GIT_DIFF_OPTS) $diffopts
2398     set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2399     if {[catch {set mdf [open $cmd r]} err]} {
2400         error_popup "Error getting merge diffs: $err"
2401         return
2402     }
2403     fconfigure $mdf -blocking 0
2404     set mdifffd($id) $mdf
2405     fileevent $mdf readable [list getmergediffline $mdf $id]
2406     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2407 }
2408
2409 proc getmergediffline {mdf id} {
2410     global diffmergeid ctext cflist nextupdate nparents mergemax
2411     global difffilestart
2412
2413     set n [gets $mdf line]
2414     if {$n < 0} {
2415         if {[eof $mdf]} {
2416             close $mdf
2417         }
2418         return
2419     }
2420     if {![info exists diffmergeid] || $id != $diffmergeid} {
2421         return
2422     }
2423     $ctext conf -state normal
2424     if {[regexp {^diff --cc (.*)} $line match fname]} {
2425         # start of a new file
2426         $ctext insert end "\n"
2427         set here [$ctext index "end - 1c"]
2428         set i [$cflist index end]
2429         $ctext mark set fmark.$i $here
2430         $ctext mark gravity fmark.$i left
2431         set difffilestart([expr {$i-1}]) $here
2432         $cflist insert end $fname
2433         set l [expr {(78 - [string length $fname]) / 2}]
2434         set pad [string range "----------------------------------------" 1 $l]
2435         $ctext insert end "$pad $fname $pad\n" filesep
2436     } elseif {[regexp {^@@} $line]} {
2437         $ctext insert end "$line\n" hunksep
2438     } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2439         # do nothing
2440     } else {
2441         # parse the prefix - one ' ', '-' or '+' for each parent
2442         set np $nparents($id)
2443         set spaces {}
2444         set minuses {}
2445         set pluses {}
2446         set isbad 0
2447         for {set j 0} {$j < $np} {incr j} {
2448             set c [string range $line $j $j]
2449             if {$c == " "} {
2450                 lappend spaces $j
2451             } elseif {$c == "-"} {
2452                 lappend minuses $j
2453             } elseif {$c == "+"} {
2454                 lappend pluses $j
2455             } else {
2456                 set isbad 1
2457                 break
2458             }
2459         }
2460         set tags {}
2461         set num {}
2462         if {!$isbad && $minuses ne {} && $pluses eq {}} {
2463             # line doesn't appear in result, parents in $minuses have the line
2464             set num [lindex $minuses 0]
2465         } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2466             # line appears in result, parents in $pluses don't have the line
2467             lappend tags mresult
2468             set num [lindex $spaces 0]
2469         }
2470         if {$num ne {}} {
2471             if {$num >= $mergemax} {
2472                 set num "max"
2473             }
2474             lappend tags m$num
2475         }
2476         $ctext insert end "$line\n" $tags
2477     }
2478     $ctext conf -state disabled
2479     if {[clock clicks -milliseconds] >= $nextupdate} {
2480         incr nextupdate 100
2481         fileevent $mdf readable {}
2482         update
2483         fileevent $mdf readable [list getmergediffline $mdf $id]
2484     }
2485 }
2486
2487 proc startdiff {ids} {
2488     global treediffs diffids treepending diffmergeid
2489
2490     set diffids $ids
2491     catch {unset diffmergeid}
2492     if {![info exists treediffs($ids)]} {
2493         if {![info exists treepending]} {
2494             gettreediffs $ids
2495         }
2496     } else {
2497         addtocflist $ids
2498     }
2499 }
2500
2501 proc addtocflist {ids} {
2502     global treediffs cflist
2503     foreach f $treediffs($ids) {
2504         $cflist insert end $f
2505     }
2506     getblobdiffs $ids
2507 }
2508
2509 proc gettreediffs {ids} {
2510     global treediff parents treepending
2511     set treepending $ids
2512     set treediff {}
2513     if {[catch \
2514          {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2515         ]} return
2516     fconfigure $gdtf -blocking 0
2517     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2518 }
2519
2520 proc gettreediffline {gdtf ids} {
2521     global treediff treediffs treepending diffids diffmergeid
2522
2523     set n [gets $gdtf line]
2524     if {$n < 0} {
2525         if {![eof $gdtf]} return
2526         close $gdtf
2527         set treediffs($ids) $treediff
2528         unset treepending
2529         if {$ids != $diffids} {
2530             gettreediffs $diffids
2531         } else {
2532             if {[info exists diffmergeid]} {
2533                 contmergediff $ids
2534             } else {
2535                 addtocflist $ids
2536             }
2537         }
2538         return
2539     }
2540     set file [lindex $line 5]
2541     lappend treediff $file
2542 }
2543
2544 proc getblobdiffs {ids} {
2545     global diffopts blobdifffd diffids env curdifftag curtagstart
2546     global difffilestart nextupdate diffinhdr treediffs
2547
2548     set env(GIT_DIFF_OPTS) $diffopts
2549     set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2550     if {[catch {set bdf [open $cmd r]} err]} {
2551         puts "error getting diffs: $err"
2552         return
2553     }
2554     set diffinhdr 0
2555     fconfigure $bdf -blocking 0
2556     set blobdifffd($ids) $bdf
2557     set curdifftag Comments
2558     set curtagstart 0.0
2559     catch {unset difffilestart}
2560     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2561     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2562 }
2563
2564 proc getblobdiffline {bdf ids} {
2565     global diffids blobdifffd ctext curdifftag curtagstart
2566     global diffnexthead diffnextnote difffilestart
2567     global nextupdate diffinhdr treediffs
2568
2569     set n [gets $bdf line]
2570     if {$n < 0} {
2571         if {[eof $bdf]} {
2572             close $bdf
2573             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
2574                 $ctext tag add $curdifftag $curtagstart end
2575             }
2576         }
2577         return
2578     }
2579     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
2580         return
2581     }
2582     $ctext conf -state normal
2583     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
2584         # start of a new file
2585         $ctext insert end "\n"
2586         $ctext tag add $curdifftag $curtagstart end
2587         set curtagstart [$ctext index "end - 1c"]
2588         set header $newname
2589         set here [$ctext index "end - 1c"]
2590         set i [lsearch -exact $treediffs($diffids) $fname]
2591         if {$i >= 0} {
2592             set difffilestart($i) $here
2593             incr i
2594             $ctext mark set fmark.$i $here
2595             $ctext mark gravity fmark.$i left
2596         }
2597         if {$newname != $fname} {
2598             set i [lsearch -exact $treediffs($diffids) $newname]
2599             if {$i >= 0} {
2600                 set difffilestart($i) $here
2601                 incr i
2602                 $ctext mark set fmark.$i $here
2603                 $ctext mark gravity fmark.$i left
2604             }
2605         }
2606         set curdifftag "f:$fname"
2607         $ctext tag delete $curdifftag
2608         set l [expr {(78 - [string length $header]) / 2}]
2609         set pad [string range "----------------------------------------" 1 $l]
2610         $ctext insert end "$pad $header $pad\n" filesep
2611         set diffinhdr 1
2612     } elseif {[regexp {^(---|\+\+\+)} $line]} {
2613         set diffinhdr 0
2614     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
2615                    $line match f1l f1c f2l f2c rest]} {
2616         $ctext insert end "$line\n" hunksep
2617         set diffinhdr 0
2618     } else {
2619         set x [string range $line 0 0]
2620         if {$x == "-" || $x == "+"} {
2621             set tag [expr {$x == "+"}]
2622             $ctext insert end "$line\n" d$tag
2623         } elseif {$x == " "} {
2624             $ctext insert end "$line\n"
2625         } elseif {$diffinhdr || $x == "\\"} {
2626             # e.g. "\ No newline at end of file"
2627             $ctext insert end "$line\n" filesep
2628         } else {
2629             # Something else we don't recognize
2630             if {$curdifftag != "Comments"} {
2631                 $ctext insert end "\n"
2632                 $ctext tag add $curdifftag $curtagstart end
2633                 set curtagstart [$ctext index "end - 1c"]
2634                 set curdifftag Comments
2635             }
2636             $ctext insert end "$line\n" filesep
2637         }
2638     }
2639     $ctext conf -state disabled
2640     if {[clock clicks -milliseconds] >= $nextupdate} {
2641         incr nextupdate 100
2642         fileevent $bdf readable {}
2643         update
2644         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
2645     }
2646 }
2647
2648 proc nextfile {} {
2649     global difffilestart ctext
2650     set here [$ctext index @0,0]
2651     for {set i 0} {[info exists difffilestart($i)]} {incr i} {
2652         if {[$ctext compare $difffilestart($i) > $here]} {
2653             if {![info exists pos]
2654                 || [$ctext compare $difffilestart($i) < $pos]} {
2655                 set pos $difffilestart($i)
2656             }
2657         }
2658     }
2659     if {[info exists pos]} {
2660         $ctext yview $pos
2661     }
2662 }
2663
2664 proc listboxsel {} {
2665     global ctext cflist currentid
2666     if {![info exists currentid]} return
2667     set sel [lsort [$cflist curselection]]
2668     if {$sel eq {}} return
2669     set first [lindex $sel 0]
2670     catch {$ctext yview fmark.$first}
2671 }
2672
2673 proc setcoords {} {
2674     global linespc charspc canvx0 canvy0 mainfont
2675     global xspc1 xspc2 lthickness
2676
2677     set linespc [font metrics $mainfont -linespace]
2678     set charspc [font measure $mainfont "m"]
2679     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
2680     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
2681     set lthickness [expr {int($linespc / 9) + 1}]
2682     set xspc1(0) $linespc
2683     set xspc2 $linespc
2684 }
2685
2686 proc redisplay {} {
2687     global canv canvy0 linespc numcommits
2688     global selectedline
2689
2690     set ymax [lindex [$canv cget -scrollregion] 3]
2691     if {$ymax eq {} || $ymax == 0} return
2692     set span [$canv yview]
2693     clear_display
2694     allcanvs conf -scrollregion \
2695         [list 0 0 0 [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]]
2696     allcanvs yview moveto [lindex $span 0]
2697     drawvisible
2698     if {[info exists selectedline]} {
2699         selectline $selectedline 0
2700     }
2701 }
2702
2703 proc incrfont {inc} {
2704     global mainfont namefont textfont ctext canv phase
2705     global stopped entries
2706     unmarkmatches
2707     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
2708     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
2709     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
2710     setcoords
2711     $ctext conf -font $textfont
2712     $ctext tag conf filesep -font [concat $textfont bold]
2713     foreach e $entries {
2714         $e conf -font $mainfont
2715     }
2716     if {$phase == "getcommits"} {
2717         $canv itemconf textitems -font $mainfont
2718     }
2719     redisplay
2720 }
2721
2722 proc clearsha1 {} {
2723     global sha1entry sha1string
2724     if {[string length $sha1string] == 40} {
2725         $sha1entry delete 0 end
2726     }
2727 }
2728
2729 proc sha1change {n1 n2 op} {
2730     global sha1string currentid sha1but
2731     if {$sha1string == {}
2732         || ([info exists currentid] && $sha1string == $currentid)} {
2733         set state disabled
2734     } else {
2735         set state normal
2736     }
2737     if {[$sha1but cget -state] == $state} return
2738     if {$state == "normal"} {
2739         $sha1but conf -state normal -relief raised -text "Goto: "
2740     } else {
2741         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
2742     }
2743 }
2744
2745 proc gotocommit {} {
2746     global sha1string currentid commitrow tagids
2747     global displayorder numcommits
2748
2749     if {$sha1string == {}
2750         || ([info exists currentid] && $sha1string == $currentid)} return
2751     if {[info exists tagids($sha1string)]} {
2752         set id $tagids($sha1string)
2753     } else {
2754         set id [string tolower $sha1string]
2755         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
2756             set matches {}
2757             foreach i $displayorder {
2758                 if {[string match $id* $i]} {
2759                     lappend matches $i
2760                 }
2761             }
2762             if {$matches ne {}} {
2763                 if {[llength $matches] > 1} {
2764                     error_popup "Short SHA1 id $id is ambiguous"
2765                     return
2766                 }
2767                 set id [lindex $matches 0]
2768             }
2769         }
2770     }
2771     if {[info exists commitrow($id)]} {
2772         selectline $commitrow($id) 1
2773         return
2774     }
2775     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
2776         set type "SHA1 id"
2777     } else {
2778         set type "Tag"
2779     }
2780     error_popup "$type $sha1string is not known"
2781 }
2782
2783 proc lineenter {x y id} {
2784     global hoverx hovery hoverid hovertimer
2785     global commitinfo canv
2786
2787     if {![info exists commitinfo($id)] && ![getcommit $id]} return
2788     set hoverx $x
2789     set hovery $y
2790     set hoverid $id
2791     if {[info exists hovertimer]} {
2792         after cancel $hovertimer
2793     }
2794     set hovertimer [after 500 linehover]
2795     $canv delete hover
2796 }
2797
2798 proc linemotion {x y id} {
2799     global hoverx hovery hoverid hovertimer
2800
2801     if {[info exists hoverid] && $id == $hoverid} {
2802         set hoverx $x
2803         set hovery $y
2804         if {[info exists hovertimer]} {
2805             after cancel $hovertimer
2806         }
2807         set hovertimer [after 500 linehover]
2808     }
2809 }
2810
2811 proc lineleave {id} {
2812     global hoverid hovertimer canv
2813
2814     if {[info exists hoverid] && $id == $hoverid} {
2815         $canv delete hover
2816         if {[info exists hovertimer]} {
2817             after cancel $hovertimer
2818             unset hovertimer
2819         }
2820         unset hoverid
2821     }
2822 }
2823
2824 proc linehover {} {
2825     global hoverx hovery hoverid hovertimer
2826     global canv linespc lthickness
2827     global commitinfo mainfont
2828
2829     set text [lindex $commitinfo($hoverid) 0]
2830     set ymax [lindex [$canv cget -scrollregion] 3]
2831     if {$ymax == {}} return
2832     set yfrac [lindex [$canv yview] 0]
2833     set x [expr {$hoverx + 2 * $linespc}]
2834     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
2835     set x0 [expr {$x - 2 * $lthickness}]
2836     set y0 [expr {$y - 2 * $lthickness}]
2837     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
2838     set y1 [expr {$y + $linespc + 2 * $lthickness}]
2839     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
2840                -fill \#ffff80 -outline black -width 1 -tags hover]
2841     $canv raise $t
2842     set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
2843     $canv raise $t
2844 }
2845
2846 proc clickisonarrow {id y} {
2847     global lthickness idrowranges
2848
2849     set thresh [expr {2 * $lthickness + 6}]
2850     set n [expr {[llength $idrowranges($id)] - 1}]
2851     for {set i 1} {$i < $n} {incr i} {
2852         set row [lindex $idrowranges($id) $i]
2853         if {abs([yc $row] - $y) < $thresh} {
2854             return $i
2855         }
2856     }
2857     return {}
2858 }
2859
2860 proc arrowjump {id n y} {
2861     global idrowranges canv
2862
2863     # 1 <-> 2, 3 <-> 4, etc...
2864     set n [expr {(($n - 1) ^ 1) + 1}]
2865     set row [lindex $idrowranges($id) $n]
2866     set yt [yc $row]
2867     set ymax [lindex [$canv cget -scrollregion] 3]
2868     if {$ymax eq {} || $ymax <= 0} return
2869     set view [$canv yview]
2870     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
2871     set yfrac [expr {$yt / $ymax - $yspan / 2}]
2872     if {$yfrac < 0} {
2873         set yfrac 0
2874     }
2875     allcanvs yview moveto $yfrac
2876 }
2877
2878 proc lineclick {x y id isnew} {
2879     global ctext commitinfo children cflist canv thickerline
2880
2881     if {![info exists commitinfo($id)] && ![getcommit $id]} return
2882     unmarkmatches
2883     unselectline
2884     normalline
2885     $canv delete hover
2886     # draw this line thicker than normal
2887     drawlines $id 1
2888     set thickerline $id
2889     if {$isnew} {
2890         set ymax [lindex [$canv cget -scrollregion] 3]
2891         if {$ymax eq {}} return
2892         set yfrac [lindex [$canv yview] 0]
2893         set y [expr {$y + $yfrac * $ymax}]
2894     }
2895     set dirn [clickisonarrow $id $y]
2896     if {$dirn ne {}} {
2897         arrowjump $id $dirn $y
2898         return
2899     }
2900
2901     if {$isnew} {
2902         addtohistory [list lineclick $x $y $id 0]
2903     }
2904     # fill the details pane with info about this line
2905     $ctext conf -state normal
2906     $ctext delete 0.0 end
2907     $ctext tag conf link -foreground blue -underline 1
2908     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2909     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2910     $ctext insert end "Parent:\t"
2911     $ctext insert end $id [list link link0]
2912     $ctext tag bind link0 <1> [list selbyid $id]
2913     set info $commitinfo($id)
2914     $ctext insert end "\n\t[lindex $info 0]\n"
2915     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
2916     set date [formatdate [lindex $info 2]]
2917     $ctext insert end "\tDate:\t$date\n"
2918     if {[info exists children($id)]} {
2919         $ctext insert end "\nChildren:"
2920         set i 0
2921         foreach child $children($id) {
2922             incr i
2923             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
2924             set info $commitinfo($child)
2925             $ctext insert end "\n\t"
2926             $ctext insert end $child [list link link$i]
2927             $ctext tag bind link$i <1> [list selbyid $child]
2928             $ctext insert end "\n\t[lindex $info 0]"
2929             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
2930             set date [formatdate [lindex $info 2]]
2931             $ctext insert end "\n\tDate:\t$date\n"
2932         }
2933     }
2934     $ctext conf -state disabled
2935
2936     $cflist delete 0 end
2937 }
2938
2939 proc normalline {} {
2940     global thickerline
2941     if {[info exists thickerline]} {
2942         drawlines $thickerline 0
2943         unset thickerline
2944     }
2945 }
2946
2947 proc selbyid {id} {
2948     global commitrow
2949     if {[info exists commitrow($id)]} {
2950         selectline $commitrow($id) 1
2951     }
2952 }
2953
2954 proc mstime {} {
2955     global startmstime
2956     if {![info exists startmstime]} {
2957         set startmstime [clock clicks -milliseconds]
2958     }
2959     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
2960 }
2961
2962 proc rowmenu {x y id} {
2963     global rowctxmenu commitrow selectedline rowmenuid
2964
2965     if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
2966         set state disabled
2967     } else {
2968         set state normal
2969     }
2970     $rowctxmenu entryconfigure 0 -state $state
2971     $rowctxmenu entryconfigure 1 -state $state
2972     $rowctxmenu entryconfigure 2 -state $state
2973     set rowmenuid $id
2974     tk_popup $rowctxmenu $x $y
2975 }
2976
2977 proc diffvssel {dirn} {
2978     global rowmenuid selectedline displayorder
2979
2980     if {![info exists selectedline]} return
2981     if {$dirn} {
2982         set oldid [lindex $displayorder $selectedline]
2983         set newid $rowmenuid
2984     } else {
2985         set oldid $rowmenuid
2986         set newid [lindex $displayorder $selectedline]
2987     }
2988     addtohistory [list doseldiff $oldid $newid]
2989     doseldiff $oldid $newid
2990 }
2991
2992 proc doseldiff {oldid newid} {
2993     global ctext cflist
2994     global commitinfo
2995
2996     $ctext conf -state normal
2997     $ctext delete 0.0 end
2998     $ctext mark set fmark.0 0.0
2999     $ctext mark gravity fmark.0 left
3000     $cflist delete 0 end
3001     $cflist insert end "Top"
3002     $ctext insert end "From "
3003     $ctext tag conf link -foreground blue -underline 1
3004     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3005     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3006     $ctext tag bind link0 <1> [list selbyid $oldid]
3007     $ctext insert end $oldid [list link link0]
3008     $ctext insert end "\n     "
3009     $ctext insert end [lindex $commitinfo($oldid) 0]
3010     $ctext insert end "\n\nTo   "
3011     $ctext tag bind link1 <1> [list selbyid $newid]
3012     $ctext insert end $newid [list link link1]
3013     $ctext insert end "\n     "
3014     $ctext insert end [lindex $commitinfo($newid) 0]
3015     $ctext insert end "\n"
3016     $ctext conf -state disabled
3017     $ctext tag delete Comments
3018     $ctext tag remove found 1.0 end
3019     startdiff [list $oldid $newid]
3020 }
3021
3022 proc mkpatch {} {
3023     global rowmenuid currentid commitinfo patchtop patchnum
3024
3025     if {![info exists currentid]} return
3026     set oldid $currentid
3027     set oldhead [lindex $commitinfo($oldid) 0]
3028     set newid $rowmenuid
3029     set newhead [lindex $commitinfo($newid) 0]
3030     set top .patch
3031     set patchtop $top
3032     catch {destroy $top}
3033     toplevel $top
3034     label $top.title -text "Generate patch"
3035     grid $top.title - -pady 10
3036     label $top.from -text "From:"
3037     entry $top.fromsha1 -width 40 -relief flat
3038     $top.fromsha1 insert 0 $oldid
3039     $top.fromsha1 conf -state readonly
3040     grid $top.from $top.fromsha1 -sticky w
3041     entry $top.fromhead -width 60 -relief flat
3042     $top.fromhead insert 0 $oldhead
3043     $top.fromhead conf -state readonly
3044     grid x $top.fromhead -sticky w
3045     label $top.to -text "To:"
3046     entry $top.tosha1 -width 40 -relief flat
3047     $top.tosha1 insert 0 $newid
3048     $top.tosha1 conf -state readonly
3049     grid $top.to $top.tosha1 -sticky w
3050     entry $top.tohead -width 60 -relief flat
3051     $top.tohead insert 0 $newhead
3052     $top.tohead conf -state readonly
3053     grid x $top.tohead -sticky w
3054     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3055     grid $top.rev x -pady 10
3056     label $top.flab -text "Output file:"
3057     entry $top.fname -width 60
3058     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3059     incr patchnum
3060     grid $top.flab $top.fname -sticky w
3061     frame $top.buts
3062     button $top.buts.gen -text "Generate" -command mkpatchgo
3063     button $top.buts.can -text "Cancel" -command mkpatchcan
3064     grid $top.buts.gen $top.buts.can
3065     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3066     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3067     grid $top.buts - -pady 10 -sticky ew
3068     focus $top.fname
3069 }
3070
3071 proc mkpatchrev {} {
3072     global patchtop
3073
3074     set oldid [$patchtop.fromsha1 get]
3075     set oldhead [$patchtop.fromhead get]
3076     set newid [$patchtop.tosha1 get]
3077     set newhead [$patchtop.tohead get]
3078     foreach e [list fromsha1 fromhead tosha1 tohead] \
3079             v [list $newid $newhead $oldid $oldhead] {
3080         $patchtop.$e conf -state normal
3081         $patchtop.$e delete 0 end
3082         $patchtop.$e insert 0 $v
3083         $patchtop.$e conf -state readonly
3084     }
3085 }
3086
3087 proc mkpatchgo {} {
3088     global patchtop
3089
3090     set oldid [$patchtop.fromsha1 get]
3091     set newid [$patchtop.tosha1 get]
3092     set fname [$patchtop.fname get]
3093     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3094         error_popup "Error creating patch: $err"
3095     }
3096     catch {destroy $patchtop}
3097     unset patchtop
3098 }
3099
3100 proc mkpatchcan {} {
3101     global patchtop
3102
3103     catch {destroy $patchtop}
3104     unset patchtop
3105 }
3106
3107 proc mktag {} {
3108     global rowmenuid mktagtop commitinfo
3109
3110     set top .maketag
3111     set mktagtop $top
3112     catch {destroy $top}
3113     toplevel $top
3114     label $top.title -text "Create tag"
3115     grid $top.title - -pady 10
3116     label $top.id -text "ID:"
3117     entry $top.sha1 -width 40 -relief flat
3118     $top.sha1 insert 0 $rowmenuid
3119     $top.sha1 conf -state readonly
3120     grid $top.id $top.sha1 -sticky w
3121     entry $top.head -width 60 -relief flat
3122     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3123     $top.head conf -state readonly
3124     grid x $top.head -sticky w
3125     label $top.tlab -text "Tag name:"
3126     entry $top.tag -width 60
3127     grid $top.tlab $top.tag -sticky w
3128     frame $top.buts
3129     button $top.buts.gen -text "Create" -command mktaggo
3130     button $top.buts.can -text "Cancel" -command mktagcan
3131     grid $top.buts.gen $top.buts.can
3132     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3133     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3134     grid $top.buts - -pady 10 -sticky ew
3135     focus $top.tag
3136 }
3137
3138 proc domktag {} {
3139     global mktagtop env tagids idtags
3140
3141     set id [$mktagtop.sha1 get]
3142     set tag [$mktagtop.tag get]
3143     if {$tag == {}} {
3144         error_popup "No tag name specified"
3145         return
3146     }
3147     if {[info exists tagids($tag)]} {
3148         error_popup "Tag \"$tag\" already exists"
3149         return
3150     }
3151     if {[catch {
3152         set dir [gitdir]
3153         set fname [file join $dir "refs/tags" $tag]
3154         set f [open $fname w]
3155         puts $f $id
3156         close $f
3157     } err]} {
3158         error_popup "Error creating tag: $err"
3159         return
3160     }
3161
3162     set tagids($tag) $id
3163     lappend idtags($id) $tag
3164     redrawtags $id
3165 }
3166
3167 proc redrawtags {id} {
3168     global canv linehtag commitrow idpos selectedline
3169
3170     if {![info exists commitrow($id)]} return
3171     drawcmitrow $commitrow($id)
3172     $canv delete tag.$id
3173     set xt [eval drawtags $id $idpos($id)]
3174     $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3175     if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3176         selectline $selectedline 0
3177     }
3178 }
3179
3180 proc mktagcan {} {
3181     global mktagtop
3182
3183     catch {destroy $mktagtop}
3184     unset mktagtop
3185 }
3186
3187 proc mktaggo {} {
3188     domktag
3189     mktagcan
3190 }
3191
3192 proc writecommit {} {
3193     global rowmenuid wrcomtop commitinfo wrcomcmd
3194
3195     set top .writecommit
3196     set wrcomtop $top
3197     catch {destroy $top}
3198     toplevel $top
3199     label $top.title -text "Write commit to file"
3200     grid $top.title - -pady 10
3201     label $top.id -text "ID:"
3202     entry $top.sha1 -width 40 -relief flat
3203     $top.sha1 insert 0 $rowmenuid
3204     $top.sha1 conf -state readonly
3205     grid $top.id $top.sha1 -sticky w
3206     entry $top.head -width 60 -relief flat
3207     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3208     $top.head conf -state readonly
3209     grid x $top.head -sticky w
3210     label $top.clab -text "Command:"
3211     entry $top.cmd -width 60 -textvariable wrcomcmd
3212     grid $top.clab $top.cmd -sticky w -pady 10
3213     label $top.flab -text "Output file:"
3214     entry $top.fname -width 60
3215     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3216     grid $top.flab $top.fname -sticky w
3217     frame $top.buts
3218     button $top.buts.gen -text "Write" -command wrcomgo
3219     button $top.buts.can -text "Cancel" -command wrcomcan
3220     grid $top.buts.gen $top.buts.can
3221     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3222     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3223     grid $top.buts - -pady 10 -sticky ew
3224     focus $top.fname
3225 }
3226
3227 proc wrcomgo {} {
3228     global wrcomtop
3229
3230     set id [$wrcomtop.sha1 get]
3231     set cmd "echo $id | [$wrcomtop.cmd get]"
3232     set fname [$wrcomtop.fname get]
3233     if {[catch {exec sh -c $cmd >$fname &} err]} {
3234         error_popup "Error writing commit: $err"
3235     }
3236     catch {destroy $wrcomtop}
3237     unset wrcomtop
3238 }
3239
3240 proc wrcomcan {} {
3241     global wrcomtop
3242
3243     catch {destroy $wrcomtop}
3244     unset wrcomtop
3245 }
3246
3247 proc listrefs {id} {
3248     global idtags idheads idotherrefs
3249
3250     set x {}
3251     if {[info exists idtags($id)]} {
3252         set x $idtags($id)
3253     }
3254     set y {}
3255     if {[info exists idheads($id)]} {
3256         set y $idheads($id)
3257     }
3258     set z {}
3259     if {[info exists idotherrefs($id)]} {
3260         set z $idotherrefs($id)
3261     }
3262     return [list $x $y $z]
3263 }
3264
3265 proc rereadrefs {} {
3266     global idtags idheads idotherrefs
3267     global tagids headids otherrefids
3268
3269     set refids [concat [array names idtags] \
3270                     [array names idheads] [array names idotherrefs]]
3271     foreach id $refids {
3272         if {![info exists ref($id)]} {
3273             set ref($id) [listrefs $id]
3274         }
3275     }
3276     readrefs
3277     set refids [lsort -unique [concat $refids [array names idtags] \
3278                         [array names idheads] [array names idotherrefs]]]
3279     foreach id $refids {
3280         set v [listrefs $id]
3281         if {![info exists ref($id)] || $ref($id) != $v} {
3282             redrawtags $id
3283         }
3284     }
3285 }
3286
3287 proc showtag {tag isnew} {
3288     global ctext cflist tagcontents tagids linknum
3289
3290     if {$isnew} {
3291         addtohistory [list showtag $tag 0]
3292     }
3293     $ctext conf -state normal
3294     $ctext delete 0.0 end
3295     set linknum 0
3296     if {[info exists tagcontents($tag)]} {
3297         set text $tagcontents($tag)
3298     } else {
3299         set text "Tag: $tag\nId:  $tagids($tag)"
3300     }
3301     appendwithlinks $text
3302     $ctext conf -state disabled
3303     $cflist delete 0 end
3304 }
3305
3306 proc doquit {} {
3307     global stopped
3308     set stopped 100
3309     destroy .
3310 }
3311
3312 proc doprefs {} {
3313     global maxwidth maxgraphpct diffopts findmergefiles
3314     global oldprefs prefstop
3315
3316     set top .gitkprefs
3317     set prefstop $top
3318     if {[winfo exists $top]} {
3319         raise $top
3320         return
3321     }
3322     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3323         set oldprefs($v) [set $v]
3324     }
3325     toplevel $top
3326     wm title $top "Gitk preferences"
3327     label $top.ldisp -text "Commit list display options"
3328     grid $top.ldisp - -sticky w -pady 10
3329     label $top.spacer -text " "
3330     label $top.maxwidthl -text "Maximum graph width (lines)" \
3331         -font optionfont
3332     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3333     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3334     label $top.maxpctl -text "Maximum graph width (% of pane)" \
3335         -font optionfont
3336     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3337     grid x $top.maxpctl $top.maxpct -sticky w
3338     checkbutton $top.findm -variable findmergefiles
3339     label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3340         -font optionfont
3341     grid $top.findm $top.findml - -sticky w
3342     label $top.ddisp -text "Diff display options"
3343     grid $top.ddisp - -sticky w -pady 10
3344     label $top.diffoptl -text "Options for diff program" \
3345         -font optionfont
3346     entry $top.diffopt -width 20 -textvariable diffopts
3347     grid x $top.diffoptl $top.diffopt -sticky w
3348     frame $top.buts
3349     button $top.buts.ok -text "OK" -command prefsok
3350     button $top.buts.can -text "Cancel" -command prefscan
3351     grid $top.buts.ok $top.buts.can
3352     grid columnconfigure $top.buts 0 -weight 1 -uniform a
3353     grid columnconfigure $top.buts 1 -weight 1 -uniform a
3354     grid $top.buts - - -pady 10 -sticky ew
3355 }
3356
3357 proc prefscan {} {
3358     global maxwidth maxgraphpct diffopts findmergefiles
3359     global oldprefs prefstop
3360
3361     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3362         set $v $oldprefs($v)
3363     }
3364     catch {destroy $prefstop}
3365     unset prefstop
3366 }
3367
3368 proc prefsok {} {
3369     global maxwidth maxgraphpct
3370     global oldprefs prefstop
3371
3372     catch {destroy $prefstop}
3373     unset prefstop
3374     if {$maxwidth != $oldprefs(maxwidth)
3375         || $maxgraphpct != $oldprefs(maxgraphpct)} {
3376         redisplay
3377     }
3378 }
3379
3380 proc formatdate {d} {
3381     return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3382 }
3383
3384 # This list of encoding names and aliases is distilled from
3385 # http://www.iana.org/assignments/character-sets.
3386 # Not all of them are supported by Tcl.
3387 set encoding_aliases {
3388     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3389       ISO646-US US-ASCII us IBM367 cp367 csASCII }
3390     { ISO-10646-UTF-1 csISO10646UTF1 }
3391     { ISO_646.basic:1983 ref csISO646basic1983 }
3392     { INVARIANT csINVARIANT }
3393     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3394     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3395     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3396     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3397     { NATS-DANO iso-ir-9-1 csNATSDANO }
3398     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3399     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3400     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3401     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3402     { ISO-2022-KR csISO2022KR }
3403     { EUC-KR csEUCKR }
3404     { ISO-2022-JP csISO2022JP }
3405     { ISO-2022-JP-2 csISO2022JP2 }
3406     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3407       csISO13JISC6220jp }
3408     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3409     { IT iso-ir-15 ISO646-IT csISO15Italian }
3410     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3411     { ES iso-ir-17 ISO646-ES csISO17Spanish }
3412     { greek7-old iso-ir-18 csISO18Greek7Old }
3413     { latin-greek iso-ir-19 csISO19LatinGreek }
3414     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3415     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3416     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3417     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3418     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3419     { BS_viewdata iso-ir-47 csISO47BSViewdata }
3420     { INIS iso-ir-49 csISO49INIS }
3421     { INIS-8 iso-ir-50 csISO50INIS8 }
3422     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3423     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3424     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3425     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3426     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3427     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3428       csISO60Norwegian1 }
3429     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3430     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3431     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3432     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3433     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3434     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3435     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3436     { greek7 iso-ir-88 csISO88Greek7 }
3437     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3438     { iso-ir-90 csISO90 }
3439     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3440     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3441       csISO92JISC62991984b }
3442     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3443     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3444     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3445       csISO95JIS62291984handadd }
3446     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3447     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3448     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3449     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3450       CP819 csISOLatin1 }
3451     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3452     { T.61-7bit iso-ir-102 csISO102T617bit }
3453     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3454     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3455     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3456     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3457     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3458     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3459     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3460     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3461       arabic csISOLatinArabic }
3462     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3463     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3464     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3465       greek greek8 csISOLatinGreek }
3466     { T.101-G2 iso-ir-128 csISO128T101G2 }
3467     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3468       csISOLatinHebrew }
3469     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3470     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3471     { CSN_369103 iso-ir-139 csISO139CSN369103 }
3472     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3473     { ISO_6937-2-add iso-ir-142 csISOTextComm }
3474     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3475     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3476       csISOLatinCyrillic }
3477     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3478     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3479     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3480     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3481     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3482     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3483     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3484     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3485     { ISO_10367-box iso-ir-155 csISO10367Box }
3486     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3487     { latin-lap lap iso-ir-158 csISO158Lap }
3488     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3489     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3490     { us-dk csUSDK }
3491     { dk-us csDKUS }
3492     { JIS_X0201 X0201 csHalfWidthKatakana }
3493     { KSC5636 ISO646-KR csKSC5636 }
3494     { ISO-10646-UCS-2 csUnicode }
3495     { ISO-10646-UCS-4 csUCS4 }
3496     { DEC-MCS dec csDECMCS }
3497     { hp-roman8 roman8 r8 csHPRoman8 }
3498     { macintosh mac csMacintosh }
3499     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3500       csIBM037 }
3501     { IBM038 EBCDIC-INT cp038 csIBM038 }
3502     { IBM273 CP273 csIBM273 }
3503     { IBM274 EBCDIC-BE CP274 csIBM274 }
3504     { IBM275 EBCDIC-BR cp275 csIBM275 }
3505     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3506     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3507     { IBM280 CP280 ebcdic-cp-it csIBM280 }
3508     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3509     { IBM284 CP284 ebcdic-cp-es csIBM284 }
3510     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3511     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3512     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3513     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3514     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3515     { IBM424 cp424 ebcdic-cp-he csIBM424 }
3516     { IBM437 cp437 437 csPC8CodePage437 }
3517     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3518     { IBM775 cp775 csPC775Baltic }
3519     { IBM850 cp850 850 csPC850Multilingual }
3520     { IBM851 cp851 851 csIBM851 }
3521     { IBM852 cp852 852 csPCp852 }
3522     { IBM855 cp855 855 csIBM855 }
3523     { IBM857 cp857 857 csIBM857 }
3524     { IBM860 cp860 860 csIBM860 }
3525     { IBM861 cp861 861 cp-is csIBM861 }
3526     { IBM862 cp862 862 csPC862LatinHebrew }
3527     { IBM863 cp863 863 csIBM863 }
3528     { IBM864 cp864 csIBM864 }
3529     { IBM865 cp865 865 csIBM865 }
3530     { IBM866 cp866 866 csIBM866 }
3531     { IBM868 CP868 cp-ar csIBM868 }
3532     { IBM869 cp869 869 cp-gr csIBM869 }
3533     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3534     { IBM871 CP871 ebcdic-cp-is csIBM871 }
3535     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3536     { IBM891 cp891 csIBM891 }
3537     { IBM903 cp903 csIBM903 }
3538     { IBM904 cp904 904 csIBBM904 }
3539     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3540     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3541     { IBM1026 CP1026 csIBM1026 }
3542     { EBCDIC-AT-DE csIBMEBCDICATDE }
3543     { EBCDIC-AT-DE-A csEBCDICATDEA }
3544     { EBCDIC-CA-FR csEBCDICCAFR }
3545     { EBCDIC-DK-NO csEBCDICDKNO }
3546     { EBCDIC-DK-NO-A csEBCDICDKNOA }
3547     { EBCDIC-FI-SE csEBCDICFISE }
3548     { EBCDIC-FI-SE-A csEBCDICFISEA }
3549     { EBCDIC-FR csEBCDICFR }
3550     { EBCDIC-IT csEBCDICIT }
3551     { EBCDIC-PT csEBCDICPT }
3552     { EBCDIC-ES csEBCDICES }
3553     { EBCDIC-ES-A csEBCDICESA }
3554     { EBCDIC-ES-S csEBCDICESS }
3555     { EBCDIC-UK csEBCDICUK }
3556     { EBCDIC-US csEBCDICUS }
3557     { UNKNOWN-8BIT csUnknown8BiT }
3558     { MNEMONIC csMnemonic }
3559     { MNEM csMnem }
3560     { VISCII csVISCII }
3561     { VIQR csVIQR }
3562     { KOI8-R csKOI8R }
3563     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3564     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3565     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3566     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
3567     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
3568     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
3569     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
3570     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
3571     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
3572     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
3573     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
3574     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
3575     { IBM1047 IBM-1047 }
3576     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
3577     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
3578     { UNICODE-1-1 csUnicode11 }
3579     { CESU-8 csCESU-8 }
3580     { BOCU-1 csBOCU-1 }
3581     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
3582     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
3583       l8 }
3584     { ISO-8859-15 ISO_8859-15 Latin-9 }
3585     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
3586     { GBK CP936 MS936 windows-936 }
3587     { JIS_Encoding csJISEncoding }
3588     { Shift_JIS MS_Kanji csShiftJIS }
3589     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
3590       EUC-JP }
3591     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
3592     { ISO-10646-UCS-Basic csUnicodeASCII }
3593     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
3594     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
3595     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
3596     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
3597     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
3598     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
3599     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
3600     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
3601     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
3602     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
3603     { Adobe-Standard-Encoding csAdobeStandardEncoding }
3604     { Ventura-US csVenturaUS }
3605     { Ventura-International csVenturaInternational }
3606     { PC8-Danish-Norwegian csPC8DanishNorwegian }
3607     { PC8-Turkish csPC8Turkish }
3608     { IBM-Symbols csIBMSymbols }
3609     { IBM-Thai csIBMThai }
3610     { HP-Legal csHPLegal }
3611     { HP-Pi-font csHPPiFont }
3612     { HP-Math8 csHPMath8 }
3613     { Adobe-Symbol-Encoding csHPPSMath }
3614     { HP-DeskTop csHPDesktop }
3615     { Ventura-Math csVenturaMath }
3616     { Microsoft-Publishing csMicrosoftPublishing }
3617     { Windows-31J csWindows31J }
3618     { GB2312 csGB2312 }
3619     { Big5 csBig5 }
3620 }
3621
3622 proc tcl_encoding {enc} {
3623     global encoding_aliases
3624     set names [encoding names]
3625     set lcnames [string tolower $names]
3626     set enc [string tolower $enc]
3627     set i [lsearch -exact $lcnames $enc]
3628     if {$i < 0} {
3629         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
3630         if {[regsub {^iso[-_]} $enc iso encx]} {
3631             set i [lsearch -exact $lcnames $encx]
3632         }
3633     }
3634     if {$i < 0} {
3635         foreach l $encoding_aliases {
3636             set ll [string tolower $l]
3637             if {[lsearch -exact $ll $enc] < 0} continue
3638             # look through the aliases for one that tcl knows about
3639             foreach e $ll {
3640                 set i [lsearch -exact $lcnames $e]
3641                 if {$i < 0} {
3642                     if {[regsub {^iso[-_]} $e iso ex]} {
3643                         set i [lsearch -exact $lcnames $ex]
3644                     }
3645                 }
3646                 if {$i >= 0} break
3647             }
3648             break
3649         }
3650     }
3651     if {$i >= 0} {
3652         return [lindex $names $i]
3653     }
3654     return {}
3655 }
3656
3657 # defaults...
3658 set datemode 0
3659 set diffopts "-U 5 -p"
3660 set wrcomcmd "git-diff-tree --stdin -p --pretty"
3661
3662 set gitencoding {}
3663 catch {
3664     set gitencoding [exec git-repo-config --get i18n.commitencoding]
3665 }
3666 if {$gitencoding == ""} {
3667     set gitencoding "utf-8"
3668 }
3669 set tclencoding [tcl_encoding $gitencoding]
3670 if {$tclencoding == {}} {
3671     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
3672 }
3673
3674 set mainfont {Helvetica 9}
3675 set textfont {Courier 9}
3676 set findmergefiles 0
3677 set maxgraphpct 50
3678 set maxwidth 16
3679 set revlistorder 0
3680 set fastdate 0
3681 set uparrowlen 7
3682 set downarrowlen 7
3683 set mingaplen 30
3684
3685 set colors {green red blue magenta darkgrey brown orange}
3686
3687 catch {source ~/.gitk}
3688
3689 set namefont $mainfont
3690
3691 font create optionfont -family sans-serif -size -12
3692
3693 set revtreeargs {}
3694 foreach arg $argv {
3695     switch -regexp -- $arg {
3696         "^$" { }
3697         "^-d" { set datemode 1 }
3698         default {
3699             lappend revtreeargs $arg
3700         }
3701     }
3702 }
3703
3704 # check that we can find a .git directory somewhere...
3705 set gitdir [gitdir]
3706 if {![file isdirectory $gitdir]} {
3707     error_popup "Cannot find the git directory \"$gitdir\"."
3708     exit 1
3709 }
3710
3711 set history {}
3712 set historyindex 0
3713
3714 set optim_delay 16
3715
3716 set stopped 0
3717 set stuffsaved 0
3718 set patchnum 0
3719 setcoords
3720 makewindow $revtreeargs
3721 readrefs
3722 getcommits $revtreeargs