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