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