gitk

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