gitk

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