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