gitk

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