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