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