git.oblomov.eu Git - git/blob - 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     drawvisible
3433     if {![info exists selectedline]} return
3434     set l [expr {$selectedline + $dir * $lpp}]
3435     if {$l < 0} {
3436         set l 0
3437     } elseif {$l >= $numcommits} {
3438         set l [expr $numcommits - 1]
3439     }
3440     unmarkmatches
3441     selectline $l 1
3442 }
3443
3444 proc unselectline {} {
3445     global selectedline currentid
3446
3447     catch {unset selectedline}
3448     catch {unset currentid}
3449     allcanvs delete secsel
3450 }
3451
3452 proc reselectline {} {
3453     global selectedline
3454
3455     if {[info exists selectedline]} {
3456         selectline $selectedline 0
3457     }
3458 }
3459
3460 proc addtohistory {cmd} {
3461     global history historyindex curview
3462
3463     set elt [list $curview $cmd]
3464     if {$historyindex > 0
3465         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3466         return
3467     }
3468
3469     if {$historyindex < [llength $history]} {
3470         set history [lreplace $history $historyindex end $elt]
3471     } else {
3472         lappend history $elt
3473     }
3474     incr historyindex
3475     if {$historyindex > 1} {
3476         .ctop.top.bar.leftbut conf -state normal
3477     } else {
3478         .ctop.top.bar.leftbut conf -state disabled
3479     }
3480     .ctop.top.bar.rightbut conf -state disabled
3481 }
3482
3483 proc godo {elt} {
3484     global curview
3485
3486     set view [lindex $elt 0]
3487     set cmd [lindex $elt 1]
3488     if {$curview != $view} {
3489         showview $view
3490     }
3491     eval $cmd
3492 }
3493
3494 proc goback {} {
3495     global history historyindex
3496
3497     if {$historyindex > 1} {
3498         incr historyindex -1
3499         godo [lindex $history [expr {$historyindex - 1}]]
3500         .ctop.top.bar.rightbut conf -state normal
3501     }
3502     if {$historyindex <= 1} {
3503         .ctop.top.bar.leftbut conf -state disabled
3504     }
3505 }
3506
3507 proc goforw {} {
3508     global history historyindex
3509
3510     if {$historyindex < [llength $history]} {
3511         set cmd [lindex $history $historyindex]
3512         incr historyindex
3513         godo $cmd
3514         .ctop.top.bar.leftbut conf -state normal
3515     }
3516     if {$historyindex >= [llength $history]} {
3517         .ctop.top.bar.rightbut conf -state disabled
3518     }
3519 }
3520
3521 proc gettree {id} {
3522     global treefilelist treeidlist diffids diffmergeid treepending
3523
3524     set diffids $id
3525     catch {unset diffmergeid}
3526     if {![info exists treefilelist($id)]} {
3527         if {![info exists treepending]} {
3528             if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3529                 return
3530             }
3531             set treepending $id
3532             set treefilelist($id) {}
3533             set treeidlist($id) {}
3534             fconfigure $gtf -blocking 0
3535             fileevent $gtf readable [list gettreeline $gtf $id]
3536         }
3537     } else {
3538         setfilelist $id
3539     }
3540 }
3541
3542 proc gettreeline {gtf id} {
3543     global treefilelist treeidlist treepending cmitmode diffids
3544
3545     while {[gets $gtf line] >= 0} {
3546         if {[lindex $line 1] ne "blob"} continue
3547         set sha1 [lindex $line 2]
3548         set fname [lindex $line 3]
3549         lappend treefilelist($id) $fname
3550         lappend treeidlist($id) $sha1
3551     }
3552     if {![eof $gtf]} return
3553     close $gtf
3554     unset treepending
3555     if {$cmitmode ne "tree"} {
3556         if {![info exists diffmergeid]} {
3557             gettreediffs $diffids
3558         }
3559     } elseif {$id ne $diffids} {
3560         gettree $diffids
3561     } else {
3562         setfilelist $id
3563     }
3564 }
3565
3566 proc showfile {f} {
3567     global treefilelist treeidlist diffids
3568     global ctext commentend
3569
3570     set i [lsearch -exact $treefilelist($diffids) $f]
3571     if {$i < 0} {
3572         puts "oops, $f not in list for id $diffids"
3573         return
3574     }
3575     set blob [lindex $treeidlist($diffids) $i]
3576     if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3577         puts "oops, error reading blob $blob: $err"
3578         return
3579     }
3580     fconfigure $bf -blocking 0
3581     fileevent $bf readable [list getblobline $bf $diffids]
3582     $ctext config -state normal
3583     $ctext delete $commentend end
3584     $ctext insert end "\n"
3585     $ctext insert end "$f\n" filesep
3586     $ctext config -state disabled
3587     $ctext yview $commentend
3588 }
3589
3590 proc getblobline {bf id} {
3591     global diffids cmitmode ctext
3592
3593     if {$id ne $diffids || $cmitmode ne "tree"} {
3594         catch {close $bf}
3595         return
3596     }
3597     $ctext config -state normal
3598     while {[gets $bf line] >= 0} {
3599         $ctext insert end "$line\n"
3600     }
3601     if {[eof $bf]} {
3602         # delete last newline
3603         $ctext delete "end - 2c" "end - 1c"
3604         close $bf
3605     }
3606     $ctext config -state disabled
3607 }
3608
3609 proc mergediff {id l} {
3610     global diffmergeid diffopts mdifffd
3611     global diffids
3612     global parentlist
3613
3614     set diffmergeid $id
3615     set diffids $id
3616     # this doesn't seem to actually affect anything...
3617     set env(GIT_DIFF_OPTS) $diffopts
3618     set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3619     if {[catch {set mdf [open $cmd r]} err]} {
3620         error_popup "Error getting merge diffs: $err"
3621         return
3622     }
3623     fconfigure $mdf -blocking 0
3624     set mdifffd($id) $mdf
3625     set np [llength [lindex $parentlist $l]]
3626     fileevent $mdf readable [list getmergediffline $mdf $id $np]
3627     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3628 }
3629
3630 proc getmergediffline {mdf id np} {
3631     global diffmergeid ctext cflist nextupdate mergemax
3632     global difffilestart mdifffd
3633
3634     set n [gets $mdf line]
3635     if {$n < 0} {
3636         if {[eof $mdf]} {
3637             close $mdf
3638         }
3639         return
3640     }
3641     if {![info exists diffmergeid] || $id != $diffmergeid
3642         || $mdf != $mdifffd($id)} {
3643         return
3644     }
3645     $ctext conf -state normal
3646     if {[regexp {^diff --cc (.*)} $line match fname]} {
3647         # start of a new file
3648         $ctext insert end "\n"
3649         set here [$ctext index "end - 1c"]
3650         lappend difffilestart $here
3651         add_flist [list $fname]
3652         set l [expr {(78 - [string length $fname]) / 2}]
3653         set pad [string range "----------------------------------------" 1 $l]
3654         $ctext insert end "$pad $fname $pad\n" filesep
3655     } elseif {[regexp {^@@} $line]} {
3656         $ctext insert end "$line\n" hunksep
3657     } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3658         # do nothing
3659     } else {
3660         # parse the prefix - one ' ', '-' or '+' for each parent
3661         set spaces {}
3662         set minuses {}
3663         set pluses {}
3664         set isbad 0
3665         for {set j 0} {$j < $np} {incr j} {
3666             set c [string range $line $j $j]
3667             if {$c == " "} {
3668                 lappend spaces $j
3669             } elseif {$c == "-"} {
3670                 lappend minuses $j
3671             } elseif {$c == "+"} {
3672                 lappend pluses $j
3673             } else {
3674                 set isbad 1
3675                 break
3676             }
3677         }
3678         set tags {}
3679         set num {}
3680         if {!$isbad && $minuses ne {} && $pluses eq {}} {
3681             # line doesn't appear in result, parents in $minuses have the line
3682             set num [lindex $minuses 0]
3683         } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3684             # line appears in result, parents in $pluses don't have the line
3685             lappend tags mresult
3686             set num [lindex $spaces 0]
3687         }
3688         if {$num ne {}} {
3689             if {$num >= $mergemax} {
3690                 set num "max"
3691             }
3692             lappend tags m$num
3693         }
3694         $ctext insert end "$line\n" $tags
3695     }
3696     $ctext conf -state disabled
3697     if {[clock clicks -milliseconds] >= $nextupdate} {
3698         incr nextupdate 100
3699         fileevent $mdf readable {}
3700         update
3701         fileevent $mdf readable [list getmergediffline $mdf $id $np]
3702     }
3703 }
3704
3705 proc startdiff {ids} {
3706     global treediffs diffids treepending diffmergeid
3707
3708     set diffids $ids
3709     catch {unset diffmergeid}
3710     if {![info exists treediffs($ids)]} {
3711         if {![info exists treepending]} {
3712             gettreediffs $ids
3713         }
3714     } else {
3715         addtocflist $ids
3716     }
3717 }
3718
3719 proc addtocflist {ids} {
3720     global treediffs cflist
3721     add_flist $treediffs($ids)
3722     getblobdiffs $ids
3723 }
3724
3725 proc gettreediffs {ids} {
3726     global treediff treepending
3727     set treepending $ids
3728     set treediff {}
3729     if {[catch \
3730          {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3731         ]} return
3732     fconfigure $gdtf -blocking 0
3733     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3734 }
3735
3736 proc gettreediffline {gdtf ids} {
3737     global treediff treediffs treepending diffids diffmergeid
3738     global cmitmode
3739
3740     set n [gets $gdtf line]
3741     if {$n < 0} {
3742         if {![eof $gdtf]} return
3743         close $gdtf
3744         set treediffs($ids) $treediff
3745         unset treepending
3746         if {$cmitmode eq "tree"} {
3747             gettree $diffids
3748         } elseif {$ids != $diffids} {
3749             if {![info exists diffmergeid]} {
3750                 gettreediffs $diffids
3751             }
3752         } else {
3753             addtocflist $ids
3754         }
3755         return
3756     }
3757     set file [lindex $line 5]
3758     lappend treediff $file
3759 }
3760
3761 proc getblobdiffs {ids} {
3762     global diffopts blobdifffd diffids env curdifftag curtagstart
3763     global nextupdate diffinhdr treediffs
3764
3765     set env(GIT_DIFF_OPTS) $diffopts
3766     set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3767     if {[catch {set bdf [open $cmd r]} err]} {
3768         puts "error getting diffs: $err"
3769         return
3770     }
3771     set diffinhdr 0
3772     fconfigure $bdf -blocking 0
3773     set blobdifffd($ids) $bdf
3774     set curdifftag Comments
3775     set curtagstart 0.0
3776     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3777     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3778 }
3779
3780 proc setinlist {var i val} {
3781     global $var
3782
3783     while {[llength [set $var]] < $i} {
3784         lappend $var {}
3785     }
3786     if {[llength [set $var]] == $i} {
3787         lappend $var $val
3788     } else {
3789         lset $var $i $val
3790     }
3791 }
3792
3793 proc getblobdiffline {bdf ids} {
3794     global diffids blobdifffd ctext curdifftag curtagstart
3795     global diffnexthead diffnextnote difffilestart
3796     global nextupdate diffinhdr treediffs
3797
3798     set n [gets $bdf line]
3799     if {$n < 0} {
3800         if {[eof $bdf]} {
3801             close $bdf
3802             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3803                 $ctext tag add $curdifftag $curtagstart end
3804             }
3805         }
3806         return
3807     }
3808     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3809         return
3810     }
3811     $ctext conf -state normal
3812     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3813         # start of a new file
3814         $ctext insert end "\n"
3815         $ctext tag add $curdifftag $curtagstart end
3816         set here [$ctext index "end - 1c"]
3817         set curtagstart $here
3818         set header $newname
3819         set i [lsearch -exact $treediffs($ids) $fname]
3820         if {$i >= 0} {
3821             setinlist difffilestart $i $here
3822         }
3823         if {$newname ne $fname} {
3824             set i [lsearch -exact $treediffs($ids) $newname]
3825             if {$i >= 0} {
3826                 setinlist difffilestart $i $here
3827             }
3828         }
3829         set curdifftag "f:$fname"
3830         $ctext tag delete $curdifftag
3831         set l [expr {(78 - [string length $header]) / 2}]
3832         set pad [string range "----------------------------------------" 1 $l]
3833         $ctext insert end "$pad $header $pad\n" filesep
3834         set diffinhdr 1
3835     } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3836         # do nothing
3837     } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3838         set diffinhdr 0
3839     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3840                    $line match f1l f1c f2l f2c rest]} {
3841         $ctext insert end "$line\n" hunksep
3842         set diffinhdr 0
3843     } else {
3844         set x [string range $line 0 0]
3845         if {$x == "-" || $x == "+"} {
3846             set tag [expr {$x == "+"}]
3847             $ctext insert end "$line\n" d$tag
3848         } elseif {$x == " "} {
3849             $ctext insert end "$line\n"
3850         } elseif {$diffinhdr || $x == "\\"} {
3851             # e.g. "\ No newline at end of file"
3852             $ctext insert end "$line\n" filesep
3853         } else {
3854             # Something else we don't recognize
3855             if {$curdifftag != "Comments"} {
3856                 $ctext insert end "\n"
3857                 $ctext tag add $curdifftag $curtagstart end
3858                 set curtagstart [$ctext index "end - 1c"]
3859                 set curdifftag Comments
3860             }
3861             $ctext insert end "$line\n" filesep
3862         }
3863     }
3864     $ctext conf -state disabled
3865     if {[clock clicks -milliseconds] >= $nextupdate} {
3866         incr nextupdate 100
3867         fileevent $bdf readable {}
3868         update
3869         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3870     }
3871 }
3872
3873 proc nextfile {} {
3874     global difffilestart ctext
3875     set here [$ctext index @0,0]
3876     foreach loc $difffilestart {
3877         if {[$ctext compare $loc > $here]} {
3878             $ctext yview $loc
3879         }
3880     }
3881 }
3882
3883 proc setcoords {} {
3884     global linespc charspc canvx0 canvy0 mainfont
3885     global xspc1 xspc2 lthickness
3886
3887     set linespc [font metrics $mainfont -linespace]
3888     set charspc [font measure $mainfont "m"]
3889     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3890     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3891     set lthickness [expr {int($linespc / 9) + 1}]
3892     set xspc1(0) $linespc
3893     set xspc2 $linespc
3894 }
3895
3896 proc redisplay {} {
3897     global canv
3898     global selectedline
3899
3900     set ymax [lindex [$canv cget -scrollregion] 3]
3901     if {$ymax eq {} || $ymax == 0} return
3902     set span [$canv yview]
3903     clear_display
3904     setcanvscroll
3905     allcanvs yview moveto [lindex $span 0]
3906     drawvisible
3907     if {[info exists selectedline]} {
3908         selectline $selectedline 0
3909     }
3910 }
3911
3912 proc incrfont {inc} {
3913     global mainfont textfont ctext canv phase
3914     global stopped entries
3915     unmarkmatches
3916     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3917     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3918     setcoords
3919     $ctext conf -font $textfont
3920     $ctext tag conf filesep -font [concat $textfont bold]
3921     foreach e $entries {
3922         $e conf -font $mainfont
3923     }
3924     if {$phase eq "getcommits"} {
3925         $canv itemconf textitems -font $mainfont
3926     }
3927     redisplay
3928 }
3929
3930 proc clearsha1 {} {
3931     global sha1entry sha1string
3932     if {[string length $sha1string] == 40} {
3933         $sha1entry delete 0 end
3934     }
3935 }
3936
3937 proc sha1change {n1 n2 op} {
3938     global sha1string currentid sha1but
3939     if {$sha1string == {}
3940         || ([info exists currentid] && $sha1string == $currentid)} {
3941         set state disabled
3942     } else {
3943         set state normal
3944     }
3945     if {[$sha1but cget -state] == $state} return
3946     if {$state == "normal"} {
3947         $sha1but conf -state normal -relief raised -text "Goto: "
3948     } else {
3949         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3950     }
3951 }
3952
3953 proc gotocommit {} {
3954     global sha1string currentid commitrow tagids headids
3955     global displayorder numcommits curview
3956
3957     if {$sha1string == {}
3958         || ([info exists currentid] && $sha1string == $currentid)} return
3959     if {[info exists tagids($sha1string)]} {
3960         set id $tagids($sha1string)
3961     } elseif {[info exists headids($sha1string)]} {
3962         set id $headids($sha1string)
3963     } else {
3964         set id [string tolower $sha1string]
3965         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3966             set matches {}
3967             foreach i $displayorder {
3968                 if {[string match $id* $i]} {
3969                     lappend matches $i
3970                 }
3971             }
3972             if {$matches ne {}} {
3973                 if {[llength $matches] > 1} {
3974                     error_popup "Short SHA1 id $id is ambiguous"
3975                     return
3976                 }
3977                 set id [lindex $matches 0]
3978             }
3979         }
3980     }
3981     if {[info exists commitrow($curview,$id)]} {
3982         selectline $commitrow($curview,$id) 1
3983         return
3984     }
3985     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3986         set type "SHA1 id"
3987     } else {
3988         set type "Tag/Head"
3989     }
3990     error_popup "$type $sha1string is not known"
3991 }
3992
3993 proc lineenter {x y id} {
3994     global hoverx hovery hoverid hovertimer
3995     global commitinfo canv
3996
3997     if {![info exists commitinfo($id)] && ![getcommit $id]} return
3998     set hoverx $x
3999     set hovery $y
4000     set hoverid $id
4001     if {[info exists hovertimer]} {
4002         after cancel $hovertimer
4003     }
4004     set hovertimer [after 500 linehover]
4005     $canv delete hover
4006 }
4007
4008 proc linemotion {x y id} {
4009     global hoverx hovery hoverid hovertimer
4010
4011     if {[info exists hoverid] && $id == $hoverid} {
4012         set hoverx $x
4013         set hovery $y
4014         if {[info exists hovertimer]} {
4015             after cancel $hovertimer
4016         }
4017         set hovertimer [after 500 linehover]
4018     }
4019 }
4020
4021 proc lineleave {id} {
4022     global hoverid hovertimer canv
4023
4024     if {[info exists hoverid] && $id == $hoverid} {
4025         $canv delete hover
4026         if {[info exists hovertimer]} {
4027             after cancel $hovertimer
4028             unset hovertimer
4029         }
4030         unset hoverid
4031     }
4032 }
4033
4034 proc linehover {} {
4035     global hoverx hovery hoverid hovertimer
4036     global canv linespc lthickness
4037     global commitinfo mainfont
4038
4039     set text [lindex $commitinfo($hoverid) 0]
4040     set ymax [lindex [$canv cget -scrollregion] 3]
4041     if {$ymax == {}} return
4042     set yfrac [lindex [$canv yview] 0]
4043     set x [expr {$hoverx + 2 * $linespc}]
4044     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4045     set x0 [expr {$x - 2 * $lthickness}]
4046     set y0 [expr {$y - 2 * $lthickness}]
4047     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4048     set y1 [expr {$y + $linespc + 2 * $lthickness}]
4049     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4050                -fill \#ffff80 -outline black -width 1 -tags hover]
4051     $canv raise $t
4052     set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4053     $canv raise $t
4054 }
4055
4056 proc clickisonarrow {id y} {
4057     global lthickness
4058
4059     set ranges [rowranges $id]
4060     set thresh [expr {2 * $lthickness + 6}]
4061     set n [expr {[llength $ranges] - 1}]
4062     for {set i 1} {$i < $n} {incr i} {
4063         set row [lindex $ranges $i]
4064         if {abs([yc $row] - $y) < $thresh} {
4065             return $i
4066         }
4067     }
4068     return {}
4069 }
4070
4071 proc arrowjump {id n y} {
4072     global canv
4073
4074     # 1 <-> 2, 3 <-> 4, etc...
4075     set n [expr {(($n - 1) ^ 1) + 1}]
4076     set row [lindex [rowranges $id] $n]
4077     set yt [yc $row]
4078     set ymax [lindex [$canv cget -scrollregion] 3]
4079     if {$ymax eq {} || $ymax <= 0} return
4080     set view [$canv yview]
4081     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4082     set yfrac [expr {$yt / $ymax - $yspan / 2}]
4083     if {$yfrac < 0} {
4084         set yfrac 0
4085     }
4086     allcanvs yview moveto $yfrac
4087 }
4088
4089 proc lineclick {x y id isnew} {
4090     global ctext commitinfo children canv thickerline curview
4091
4092     if {![info exists commitinfo($id)] && ![getcommit $id]} return
4093     unmarkmatches
4094     unselectline
4095     normalline
4096     $canv delete hover
4097     # draw this line thicker than normal
4098     set thickerline $id
4099     drawlines $id
4100     if {$isnew} {
4101         set ymax [lindex [$canv cget -scrollregion] 3]
4102         if {$ymax eq {}} return
4103         set yfrac [lindex [$canv yview] 0]
4104         set y [expr {$y + $yfrac * $ymax}]
4105     }
4106     set dirn [clickisonarrow $id $y]
4107     if {$dirn ne {}} {
4108         arrowjump $id $dirn $y
4109         return
4110     }
4111
4112     if {$isnew} {
4113         addtohistory [list lineclick $x $y $id 0]
4114     }
4115     # fill the details pane with info about this line
4116     $ctext conf -state normal
4117     $ctext delete 0.0 end
4118     $ctext tag conf link -foreground blue -underline 1
4119     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4120     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4121     $ctext insert end "Parent:\t"
4122     $ctext insert end $id [list link link0]
4123     $ctext tag bind link0 <1> [list selbyid $id]
4124     set info $commitinfo($id)
4125     $ctext insert end "\n\t[lindex $info 0]\n"
4126     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4127     set date [formatdate [lindex $info 2]]
4128     $ctext insert end "\tDate:\t$date\n"
4129     set kids $children($curview,$id)
4130     if {$kids ne {}} {
4131         $ctext insert end "\nChildren:"
4132         set i 0
4133         foreach child $kids {
4134             incr i
4135             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4136             set info $commitinfo($child)
4137             $ctext insert end "\n\t"
4138             $ctext insert end $child [list link link$i]
4139             $ctext tag bind link$i <1> [list selbyid $child]
4140             $ctext insert end "\n\t[lindex $info 0]"
4141             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4142             set date [formatdate [lindex $info 2]]
4143             $ctext insert end "\n\tDate:\t$date\n"
4144         }
4145     }
4146     $ctext conf -state disabled
4147     init_flist {}
4148 }
4149
4150 proc normalline {} {
4151     global thickerline
4152     if {[info exists thickerline]} {
4153         set id $thickerline
4154         unset thickerline
4155         drawlines $id
4156     }
4157 }
4158
4159 proc selbyid {id} {
4160     global commitrow curview
4161     if {[info exists commitrow($curview,$id)]} {
4162         selectline $commitrow($curview,$id) 1
4163     }
4164 }
4165
4166 proc mstime {} {
4167     global startmstime
4168     if {![info exists startmstime]} {
4169         set startmstime [clock clicks -milliseconds]
4170     }
4171     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4172 }
4173
4174 proc rowmenu {x y id} {
4175     global rowctxmenu commitrow selectedline rowmenuid curview
4176
4177     if {![info exists selectedline]
4178         || $commitrow($curview,$id) eq $selectedline} {
4179         set state disabled
4180     } else {
4181         set state normal
4182     }
4183     $rowctxmenu entryconfigure 0 -state $state
4184     $rowctxmenu entryconfigure 1 -state $state
4185     $rowctxmenu entryconfigure 2 -state $state
4186     set rowmenuid $id
4187     tk_popup $rowctxmenu $x $y
4188 }
4189
4190 proc diffvssel {dirn} {
4191     global rowmenuid selectedline displayorder
4192
4193     if {![info exists selectedline]} return
4194     if {$dirn} {
4195         set oldid [lindex $displayorder $selectedline]
4196         set newid $rowmenuid
4197     } else {
4198         set oldid $rowmenuid
4199         set newid [lindex $displayorder $selectedline]
4200     }
4201     addtohistory [list doseldiff $oldid $newid]
4202     doseldiff $oldid $newid
4203 }
4204
4205 proc doseldiff {oldid newid} {
4206     global ctext
4207     global commitinfo
4208
4209     $ctext conf -state normal
4210     $ctext delete 0.0 end
4211     init_flist "Top"
4212     $ctext insert end "From "
4213     $ctext tag conf link -foreground blue -underline 1
4214     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4215     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4216     $ctext tag bind link0 <1> [list selbyid $oldid]
4217     $ctext insert end $oldid [list link link0]
4218     $ctext insert end "\n     "
4219     $ctext insert end [lindex $commitinfo($oldid) 0]
4220     $ctext insert end "\n\nTo   "
4221     $ctext tag bind link1 <1> [list selbyid $newid]
4222     $ctext insert end $newid [list link link1]
4223     $ctext insert end "\n     "
4224     $ctext insert end [lindex $commitinfo($newid) 0]
4225     $ctext insert end "\n"
4226     $ctext conf -state disabled
4227     $ctext tag delete Comments
4228     $ctext tag remove found 1.0 end
4229     startdiff [list $oldid $newid]
4230 }
4231
4232 proc mkpatch {} {
4233     global rowmenuid currentid commitinfo patchtop patchnum
4234
4235     if {![info exists currentid]} return
4236     set oldid $currentid
4237     set oldhead [lindex $commitinfo($oldid) 0]
4238     set newid $rowmenuid
4239     set newhead [lindex $commitinfo($newid) 0]
4240     set top .patch
4241     set patchtop $top
4242     catch {destroy $top}
4243     toplevel $top
4244     label $top.title -text "Generate patch"
4245     grid $top.title - -pady 10
4246     label $top.from -text "From:"
4247     entry $top.fromsha1 -width 40 -relief flat
4248     $top.fromsha1 insert 0 $oldid
4249     $top.fromsha1 conf -state readonly
4250     grid $top.from $top.fromsha1 -sticky w
4251     entry $top.fromhead -width 60 -relief flat
4252     $top.fromhead insert 0 $oldhead
4253     $top.fromhead conf -state readonly
4254     grid x $top.fromhead -sticky w
4255     label $top.to -text "To:"
4256     entry $top.tosha1 -width 40 -relief flat
4257     $top.tosha1 insert 0 $newid
4258     $top.tosha1 conf -state readonly
4259     grid $top.to $top.tosha1 -sticky w
4260     entry $top.tohead -width 60 -relief flat
4261     $top.tohead insert 0 $newhead
4262     $top.tohead conf -state readonly
4263     grid x $top.tohead -sticky w
4264     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4265     grid $top.rev x -pady 10
4266     label $top.flab -text "Output file:"
4267     entry $top.fname -width 60
4268     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4269     incr patchnum
4270     grid $top.flab $top.fname -sticky w
4271     frame $top.buts
4272     button $top.buts.gen -text "Generate" -command mkpatchgo
4273     button $top.buts.can -text "Cancel" -command mkpatchcan
4274     grid $top.buts.gen $top.buts.can
4275     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4276     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4277     grid $top.buts - -pady 10 -sticky ew
4278     focus $top.fname
4279 }
4280
4281 proc mkpatchrev {} {
4282     global patchtop
4283
4284     set oldid [$patchtop.fromsha1 get]
4285     set oldhead [$patchtop.fromhead get]
4286     set newid [$patchtop.tosha1 get]
4287     set newhead [$patchtop.tohead get]
4288     foreach e [list fromsha1 fromhead tosha1 tohead] \
4289             v [list $newid $newhead $oldid $oldhead] {
4290         $patchtop.$e conf -state normal
4291         $patchtop.$e delete 0 end
4292         $patchtop.$e insert 0 $v
4293         $patchtop.$e conf -state readonly
4294     }
4295 }
4296
4297 proc mkpatchgo {} {
4298     global patchtop
4299
4300     set oldid [$patchtop.fromsha1 get]
4301     set newid [$patchtop.tosha1 get]
4302     set fname [$patchtop.fname get]
4303     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4304         error_popup "Error creating patch: $err"
4305     }
4306     catch {destroy $patchtop}
4307     unset patchtop
4308 }
4309
4310 proc mkpatchcan {} {
4311     global patchtop
4312
4313     catch {destroy $patchtop}
4314     unset patchtop
4315 }
4316
4317 proc mktag {} {
4318     global rowmenuid mktagtop commitinfo
4319
4320     set top .maketag
4321     set mktagtop $top
4322     catch {destroy $top}
4323     toplevel $top
4324     label $top.title -text "Create tag"
4325     grid $top.title - -pady 10
4326     label $top.id -text "ID:"
4327     entry $top.sha1 -width 40 -relief flat
4328     $top.sha1 insert 0 $rowmenuid
4329     $top.sha1 conf -state readonly
4330     grid $top.id $top.sha1 -sticky w
4331     entry $top.head -width 60 -relief flat
4332     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4333     $top.head conf -state readonly
4334     grid x $top.head -sticky w
4335     label $top.tlab -text "Tag name:"
4336     entry $top.tag -width 60
4337     grid $top.tlab $top.tag -sticky w
4338     frame $top.buts
4339     button $top.buts.gen -text "Create" -command mktaggo
4340     button $top.buts.can -text "Cancel" -command mktagcan
4341     grid $top.buts.gen $top.buts.can
4342     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4343     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4344     grid $top.buts - -pady 10 -sticky ew
4345     focus $top.tag
4346 }
4347
4348 proc domktag {} {
4349     global mktagtop env tagids idtags
4350
4351     set id [$mktagtop.sha1 get]
4352     set tag [$mktagtop.tag get]
4353     if {$tag == {}} {
4354         error_popup "No tag name specified"
4355         return
4356     }
4357     if {[info exists tagids($tag)]} {
4358         error_popup "Tag \"$tag\" already exists"
4359         return
4360     }
4361     if {[catch {
4362         set dir [gitdir]
4363         set fname [file join $dir "refs/tags" $tag]
4364         set f [open $fname w]
4365         puts $f $id
4366         close $f
4367     } err]} {
4368         error_popup "Error creating tag: $err"
4369         return
4370     }
4371
4372     set tagids($tag) $id
4373     lappend idtags($id) $tag
4374     redrawtags $id
4375 }
4376
4377 proc redrawtags {id} {
4378     global canv linehtag commitrow idpos selectedline curview
4379
4380     if {![info exists commitrow($curview,$id)]} return
4381     drawcmitrow $commitrow($curview,$id)
4382     $canv delete tag.$id
4383     set xt [eval drawtags $id $idpos($id)]
4384     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4385     if {[info exists selectedline]
4386         && $selectedline == $commitrow($curview,$id)} {
4387         selectline $selectedline 0
4388     }
4389 }
4390
4391 proc mktagcan {} {
4392     global mktagtop
4393
4394     catch {destroy $mktagtop}
4395     unset mktagtop
4396 }
4397
4398 proc mktaggo {} {
4399     domktag
4400     mktagcan
4401 }
4402
4403 proc writecommit {} {
4404     global rowmenuid wrcomtop commitinfo wrcomcmd
4405
4406     set top .writecommit
4407     set wrcomtop $top
4408     catch {destroy $top}
4409     toplevel $top
4410     label $top.title -text "Write commit to file"
4411     grid $top.title - -pady 10
4412     label $top.id -text "ID:"
4413     entry $top.sha1 -width 40 -relief flat
4414     $top.sha1 insert 0 $rowmenuid
4415     $top.sha1 conf -state readonly
4416     grid $top.id $top.sha1 -sticky w
4417     entry $top.head -width 60 -relief flat
4418     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4419     $top.head conf -state readonly
4420     grid x $top.head -sticky w
4421     label $top.clab -text "Command:"
4422     entry $top.cmd -width 60 -textvariable wrcomcmd
4423     grid $top.clab $top.cmd -sticky w -pady 10
4424     label $top.flab -text "Output file:"
4425     entry $top.fname -width 60
4426     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4427     grid $top.flab $top.fname -sticky w
4428     frame $top.buts
4429     button $top.buts.gen -text "Write" -command wrcomgo
4430     button $top.buts.can -text "Cancel" -command wrcomcan
4431     grid $top.buts.gen $top.buts.can
4432     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4433     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4434     grid $top.buts - -pady 10 -sticky ew
4435     focus $top.fname
4436 }
4437
4438 proc wrcomgo {} {
4439     global wrcomtop
4440
4441     set id [$wrcomtop.sha1 get]
4442     set cmd "echo $id | [$wrcomtop.cmd get]"
4443     set fname [$wrcomtop.fname get]
4444     if {[catch {exec sh -c $cmd >$fname &} err]} {
4445         error_popup "Error writing commit: $err"
4446     }
4447     catch {destroy $wrcomtop}
4448     unset wrcomtop
4449 }
4450
4451 proc wrcomcan {} {
4452     global wrcomtop
4453
4454     catch {destroy $wrcomtop}
4455     unset wrcomtop
4456 }
4457
4458 proc listrefs {id} {
4459     global idtags idheads idotherrefs
4460
4461     set x {}
4462     if {[info exists idtags($id)]} {
4463         set x $idtags($id)
4464     }
4465     set y {}
4466     if {[info exists idheads($id)]} {
4467         set y $idheads($id)
4468     }
4469     set z {}
4470     if {[info exists idotherrefs($id)]} {
4471         set z $idotherrefs($id)
4472     }
4473     return [list $x $y $z]
4474 }
4475
4476 proc rereadrefs {} {
4477     global idtags idheads idotherrefs
4478
4479     set refids [concat [array names idtags] \
4480                     [array names idheads] [array names idotherrefs]]
4481     foreach id $refids {
4482         if {![info exists ref($id)]} {
4483             set ref($id) [listrefs $id]
4484         }
4485     }
4486     readrefs
4487     set refids [lsort -unique [concat $refids [array names idtags] \
4488                         [array names idheads] [array names idotherrefs]]]
4489     foreach id $refids {
4490         set v [listrefs $id]
4491         if {![info exists ref($id)] || $ref($id) != $v} {
4492             redrawtags $id
4493         }
4494     }
4495 }
4496
4497 proc showtag {tag isnew} {
4498     global ctext tagcontents tagids linknum
4499
4500     if {$isnew} {
4501         addtohistory [list showtag $tag 0]
4502     }
4503     $ctext conf -state normal
4504     $ctext delete 0.0 end
4505     set linknum 0
4506     if {[info exists tagcontents($tag)]} {
4507         set text $tagcontents($tag)
4508     } else {
4509         set text "Tag: $tag\nId:  $tagids($tag)"
4510     }
4511     appendwithlinks $text
4512     $ctext conf -state disabled
4513     init_flist {}
4514 }
4515
4516 proc doquit {} {
4517     global stopped
4518     set stopped 100
4519     destroy .
4520 }
4521
4522 proc doprefs {} {
4523     global maxwidth maxgraphpct diffopts findmergefiles
4524     global oldprefs prefstop
4525
4526     set top .gitkprefs
4527     set prefstop $top
4528     if {[winfo exists $top]} {
4529         raise $top
4530         return
4531     }
4532     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4533         set oldprefs($v) [set $v]
4534     }
4535     toplevel $top
4536     wm title $top "Gitk preferences"
4537     label $top.ldisp -text "Commit list display options"
4538     grid $top.ldisp - -sticky w -pady 10
4539     label $top.spacer -text " "
4540     label $top.maxwidthl -text "Maximum graph width (lines)" \
4541         -font optionfont
4542     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4543     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4544     label $top.maxpctl -text "Maximum graph width (% of pane)" \
4545         -font optionfont
4546     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4547     grid x $top.maxpctl $top.maxpct -sticky w
4548     checkbutton $top.findm -variable findmergefiles
4549     label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
4550         -font optionfont
4551     grid $top.findm $top.findml - -sticky w
4552     label $top.ddisp -text "Diff display options"
4553     grid $top.ddisp - -sticky w -pady 10
4554     label $top.diffoptl -text "Options for diff program" \
4555         -font optionfont
4556     entry $top.diffopt -width 20 -textvariable diffopts
4557     grid x $top.diffoptl $top.diffopt -sticky w
4558     frame $top.buts
4559     button $top.buts.ok -text "OK" -command prefsok
4560     button $top.buts.can -text "Cancel" -command prefscan
4561     grid $top.buts.ok $top.buts.can
4562     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4563     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4564     grid $top.buts - - -pady 10 -sticky ew
4565 }
4566
4567 proc prefscan {} {
4568     global maxwidth maxgraphpct diffopts findmergefiles
4569     global oldprefs prefstop
4570
4571     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4572         set $v $oldprefs($v)
4573     }
4574     catch {destroy $prefstop}
4575     unset prefstop
4576 }
4577
4578 proc prefsok {} {
4579     global maxwidth maxgraphpct
4580     global oldprefs prefstop
4581
4582     catch {destroy $prefstop}
4583     unset prefstop
4584     if {$maxwidth != $oldprefs(maxwidth)
4585         || $maxgraphpct != $oldprefs(maxgraphpct)} {
4586         redisplay
4587     }
4588 }
4589
4590 proc formatdate {d} {
4591     return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4592 }
4593
4594 # This list of encoding names and aliases is distilled from
4595 # http://www.iana.org/assignments/character-sets.
4596 # Not all of them are supported by Tcl.
4597 set encoding_aliases {
4598     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4599       ISO646-US US-ASCII us IBM367 cp367 csASCII }
4600     { ISO-10646-UTF-1 csISO10646UTF1 }
4601     { ISO_646.basic:1983 ref csISO646basic1983 }
4602     { INVARIANT csINVARIANT }
4603     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4604     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4605     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4606     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4607     { NATS-DANO iso-ir-9-1 csNATSDANO }
4608     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4609     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4610     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4611     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4612     { ISO-2022-KR csISO2022KR }
4613     { EUC-KR csEUCKR }
4614     { ISO-2022-JP csISO2022JP }
4615     { ISO-2022-JP-2 csISO2022JP2 }
4616     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4617       csISO13JISC6220jp }
4618     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4619     { IT iso-ir-15 ISO646-IT csISO15Italian }
4620     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4621     { ES iso-ir-17 ISO646-ES csISO17Spanish }
4622     { greek7-old iso-ir-18 csISO18Greek7Old }
4623     { latin-greek iso-ir-19 csISO19LatinGreek }
4624     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4625     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4626     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4627     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4628     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4629     { BS_viewdata iso-ir-47 csISO47BSViewdata }
4630     { INIS iso-ir-49 csISO49INIS }
4631     { INIS-8 iso-ir-50 csISO50INIS8 }
4632     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4633     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4634     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4635     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4636     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4637     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4638       csISO60Norwegian1 }
4639     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4640     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4641     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4642     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4643     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4644     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4645     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4646     { greek7 iso-ir-88 csISO88Greek7 }
4647     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4648     { iso-ir-90 csISO90 }
4649     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4650     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4651       csISO92JISC62991984b }
4652     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4653     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4654     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4655       csISO95JIS62291984handadd }
4656     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4657     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4658     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4659     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4660       CP819 csISOLatin1 }
4661     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4662     { T.61-7bit iso-ir-102 csISO102T617bit }
4663     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4664     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4665     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4666     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4667     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4668     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4669     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4670     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4671       arabic csISOLatinArabic }
4672     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4673     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4674     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4675       greek greek8 csISOLatinGreek }
4676     { T.101-G2 iso-ir-128 csISO128T101G2 }
4677     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4678       csISOLatinHebrew }
4679     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4680     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4681     { CSN_369103 iso-ir-139 csISO139CSN369103 }
4682     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4683     { ISO_6937-2-add iso-ir-142 csISOTextComm }
4684     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4685     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4686       csISOLatinCyrillic }
4687     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4688     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4689     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4690     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4691     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4692     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4693     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4694     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4695     { ISO_10367-box iso-ir-155 csISO10367Box }
4696     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4697     { latin-lap lap iso-ir-158 csISO158Lap }
4698     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4699     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4700     { us-dk csUSDK }
4701     { dk-us csDKUS }
4702     { JIS_X0201 X0201 csHalfWidthKatakana }
4703     { KSC5636 ISO646-KR csKSC5636 }
4704     { ISO-10646-UCS-2 csUnicode }
4705     { ISO-10646-UCS-4 csUCS4 }
4706     { DEC-MCS dec csDECMCS }
4707     { hp-roman8 roman8 r8 csHPRoman8 }
4708     { macintosh mac csMacintosh }
4709     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4710       csIBM037 }
4711     { IBM038 EBCDIC-INT cp038 csIBM038 }
4712     { IBM273 CP273 csIBM273 }
4713     { IBM274 EBCDIC-BE CP274 csIBM274 }
4714     { IBM275 EBCDIC-BR cp275 csIBM275 }
4715     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4716     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4717     { IBM280 CP280 ebcdic-cp-it csIBM280 }
4718     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4719     { IBM284 CP284 ebcdic-cp-es csIBM284 }
4720     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4721     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4722     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4723     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4724     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4725     { IBM424 cp424 ebcdic-cp-he csIBM424 }
4726     { IBM437 cp437 437 csPC8CodePage437 }
4727     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4728     { IBM775 cp775 csPC775Baltic }
4729     { IBM850 cp850 850 csPC850Multilingual }
4730     { IBM851 cp851 851 csIBM851 }
4731     { IBM852 cp852 852 csPCp852 }
4732     { IBM855 cp855 855 csIBM855 }
4733     { IBM857 cp857 857 csIBM857 }
4734     { IBM860 cp860 860 csIBM860 }
4735     { IBM861 cp861 861 cp-is csIBM861 }
4736     { IBM862 cp862 862 csPC862LatinHebrew }
4737     { IBM863 cp863 863 csIBM863 }
4738     { IBM864 cp864 csIBM864 }
4739     { IBM865 cp865 865 csIBM865 }
4740     { IBM866 cp866 866 csIBM866 }
4741     { IBM868 CP868 cp-ar csIBM868 }
4742     { IBM869 cp869 869 cp-gr csIBM869 }
4743     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4744     { IBM871 CP871 ebcdic-cp-is csIBM871 }
4745     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4746     { IBM891 cp891 csIBM891 }
4747     { IBM903 cp903 csIBM903 }
4748     { IBM904 cp904 904 csIBBM904 }
4749     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4750     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4751     { IBM1026 CP1026 csIBM1026 }
4752     { EBCDIC-AT-DE csIBMEBCDICATDE }
4753     { EBCDIC-AT-DE-A csEBCDICATDEA }
4754     { EBCDIC-CA-FR csEBCDICCAFR }
4755     { EBCDIC-DK-NO csEBCDICDKNO }
4756     { EBCDIC-DK-NO-A csEBCDICDKNOA }
4757     { EBCDIC-FI-SE csEBCDICFISE }
4758     { EBCDIC-FI-SE-A csEBCDICFISEA }
4759     { EBCDIC-FR csEBCDICFR }
4760     { EBCDIC-IT csEBCDICIT }
4761     { EBCDIC-PT csEBCDICPT }
4762     { EBCDIC-ES csEBCDICES }
4763     { EBCDIC-ES-A csEBCDICESA }
4764     { EBCDIC-ES-S csEBCDICESS }
4765     { EBCDIC-UK csEBCDICUK }
4766     { EBCDIC-US csEBCDICUS }
4767     { UNKNOWN-8BIT csUnknown8BiT }
4768     { MNEMONIC csMnemonic }
4769     { MNEM csMnem }
4770     { VISCII csVISCII }
4771     { VIQR csVIQR }
4772     { KOI8-R csKOI8R }
4773     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4774     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4775     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4776     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4777     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4778     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4779     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4780     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4781     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4782     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4783     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4784     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4785     { IBM1047 IBM-1047 }
4786     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4787     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4788     { UNICODE-1-1 csUnicode11 }
4789     { CESU-8 csCESU-8 }
4790     { BOCU-1 csBOCU-1 }
4791     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4792     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4793       l8 }
4794     { ISO-8859-15 ISO_8859-15 Latin-9 }
4795     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4796     { GBK CP936 MS936 windows-936 }
4797     { JIS_Encoding csJISEncoding }
4798     { Shift_JIS MS_Kanji csShiftJIS }
4799     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4800       EUC-JP }
4801     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4802     { ISO-10646-UCS-Basic csUnicodeASCII }
4803     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4804     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4805     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4806     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4807     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4808     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4809     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4810     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4811     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4812     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4813     { Adobe-Standard-Encoding csAdobeStandardEncoding }
4814     { Ventura-US csVenturaUS }
4815     { Ventura-International csVenturaInternational }
4816     { PC8-Danish-Norwegian csPC8DanishNorwegian }
4817     { PC8-Turkish csPC8Turkish }
4818     { IBM-Symbols csIBMSymbols }
4819     { IBM-Thai csIBMThai }
4820     { HP-Legal csHPLegal }
4821     { HP-Pi-font csHPPiFont }
4822     { HP-Math8 csHPMath8 }
4823     { Adobe-Symbol-Encoding csHPPSMath }
4824     { HP-DeskTop csHPDesktop }
4825     { Ventura-Math csVenturaMath }
4826     { Microsoft-Publishing csMicrosoftPublishing }
4827     { Windows-31J csWindows31J }
4828     { GB2312 csGB2312 }
4829     { Big5 csBig5 }
4830 }
4831
4832 proc tcl_encoding {enc} {
4833     global encoding_aliases
4834     set names [encoding names]
4835     set lcnames [string tolower $names]
4836     set enc [string tolower $enc]
4837     set i [lsearch -exact $lcnames $enc]
4838     if {$i < 0} {
4839         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4840         if {[regsub {^iso[-_]} $enc iso encx]} {
4841             set i [lsearch -exact $lcnames $encx]
4842         }
4843     }
4844     if {$i < 0} {
4845         foreach l $encoding_aliases {
4846             set ll [string tolower $l]
4847             if {[lsearch -exact $ll $enc] < 0} continue
4848             # look through the aliases for one that tcl knows about
4849             foreach e $ll {
4850                 set i [lsearch -exact $lcnames $e]
4851                 if {$i < 0} {
4852                     if {[regsub {^iso[-_]} $e iso ex]} {
4853                         set i [lsearch -exact $lcnames $ex]
4854                     }
4855                 }
4856                 if {$i >= 0} break
4857             }
4858             break
4859         }
4860     }
4861     if {$i >= 0} {
4862         return [lindex $names $i]
4863     }
4864     return {}
4865 }
4866
4867 # defaults...
4868 set datemode 0
4869 set diffopts "-U 5 -p"
4870 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4871
4872 set gitencoding {}
4873 catch {
4874     set gitencoding [exec git-repo-config --get i18n.commitencoding]
4875 }
4876 if {$gitencoding == ""} {
4877     set gitencoding "utf-8"
4878 }
4879 set tclencoding [tcl_encoding $gitencoding]
4880 if {$tclencoding == {}} {
4881     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4882 }
4883
4884 set mainfont {Helvetica 9}
4885 set textfont {Courier 9}
4886 set uifont {Helvetica 9 bold}
4887 set findmergefiles 0
4888 set maxgraphpct 50
4889 set maxwidth 16
4890 set revlistorder 0
4891 set fastdate 0
4892 set uparrowlen 7
4893 set downarrowlen 7
4894 set mingaplen 30
4895 set flistmode "flat"
4896 set cmitmode "patch"
4897
4898 set colors {green red blue magenta darkgrey brown orange}
4899
4900 catch {source ~/.gitk}
4901
4902 font create optionfont -family sans-serif -size -12
4903
4904 set revtreeargs {}
4905 foreach arg $argv {
4906     switch -regexp -- $arg {
4907         "^$" { }
4908         "^-d" { set datemode 1 }
4909         default {
4910             lappend revtreeargs $arg
4911         }
4912     }
4913 }
4914
4915 # check that we can find a .git directory somewhere...
4916 set gitdir [gitdir]
4917 if {![file isdirectory $gitdir]} {
4918     show_error . "Cannot find the git directory \"$gitdir\"."
4919     exit 1
4920 }
4921
4922 set cmdline_files {}
4923 set i [lsearch -exact $revtreeargs "--"]
4924 if {$i >= 0} {
4925     set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
4926     set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
4927 } elseif {$revtreeargs ne {}} {
4928     if {[catch {
4929         set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
4930         set cmdline_files [split $f "\n"]
4931         set n [llength $cmdline_files]
4932         set revtreeargs [lrange $revtreeargs 0 end-$n]
4933     } err]} {
4934         # unfortunately we get both stdout and stderr in $err,
4935         # so look for "fatal:".
4936         set i [string first "fatal:" $err]
4937         if {$i > 0} {
4938             set err [string range [expr {$i + 6}] end]
4939         }
4940         show_error . "Bad arguments to gitk:\n$err"
4941         exit 1
4942     }
4943 }
4944
4945 set history {}
4946 set historyindex 0
4947
4948 set optim_delay 16
4949
4950 set nextviewnum 1
4951 set curview 0
4952 set selectedview 0
4953 set selectedhlview {}
4954 set viewfiles(0) {}
4955 set viewperm(0) 0
4956 set viewargs(0) {}
4957
4958 set cmdlineok 0
4959 set stopped 0
4960 set stuffsaved 0
4961 set patchnum 0
4962 setcoords
4963 makewindow
4964 readrefs
4965
4966 if {$cmdline_files ne {} || $revtreeargs ne {}} {
4967     # create a view for the files/dirs specified on the command line
4968     set curview 1
4969     set selectedview 1
4970     set nextviewnum 2
4971     set viewname(1) "Command line"
4972     set viewfiles(1) $cmdline_files
4973     set viewargs(1) $revtreeargs
4974     set viewperm(1) 0
4975     addviewmenu 1
4976     .bar.view entryconf 2 -state normal
4977     .bar.view entryconf 3 -state normal
4978 }
4979
4980 if {[info exists permviews]} {
4981     foreach v $permviews {
4982         set n $nextviewnum
4983         incr nextviewnum
4984         set viewname($n) [lindex $v 0]
4985         set viewfiles($n) [lindex $v 1]
4986         set viewargs($n) [lindex $v 2]
4987         set viewperm($n) 1
4988         addviewmenu $n
4989     }
4990 }
4991 getcommits