gitk

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