gitk

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