gitk

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