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