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