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