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> dosearchback
 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     set l [lindex [split $first .] 0]
4200     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4201         set smarktop $l
4202     }
4203     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4204         set smarkbot $l
4205     }
4206     $ctext delete $first end
4207 }
4208
4209 proc incrsearch {name ix op} {
4210     global ctext searchstring searchdirn
4211
4212     $ctext tag remove found 1.0 end
4213     if {[catch {$ctext index anchor}]} {
4214         # no anchor set, use start of selection, or of visible area
4215         set sel [$ctext tag ranges sel]
4216         if {$sel ne {}} {
4217             $ctext mark set anchor [lindex $sel 0]
4218         } elseif {$searchdirn eq "-forwards"} {
4219             $ctext mark set anchor @0,0
4220         } else {
4221             $ctext mark set anchor @0,[winfo height $ctext]
4222         }
4223     }
4224     if {$searchstring ne {}} {
4225         set here [$ctext search $searchdirn -- $searchstring anchor]
4226         if {$here ne {}} {
4227             $ctext see $here
4228         }
4229         searchmarkvisible 1
4230     }
4231 }
4232
4233 proc dosearch {} {
4234     global sstring ctext searchstring searchdirn
4235
4236     focus $sstring
4237     $sstring icursor end
4238     set searchdirn -forwards
4239     if {$searchstring ne {}} {
4240         set sel [$ctext tag ranges sel]
4241         if {$sel ne {}} {
4242             set start "[lindex $sel 0] + 1c"
4243         } elseif {[catch {set start [$ctext index anchor]}]} {
4244             set start "@0,0"
4245         }
4246         set match [$ctext search -count mlen -- $searchstring $start]
4247         $ctext tag remove sel 1.0 end
4248         if {$match eq {}} {
4249             bell
4250             return
4251         }
4252         $ctext see $match
4253         set mend "$match + $mlen c"
4254         $ctext tag add sel $match $mend
4255         $ctext mark unset anchor
4256     }
4257 }
4258
4259 proc dosearchback {} {
4260     global sstring ctext searchstring searchdirn
4261
4262     focus $sstring
4263     $sstring icursor end
4264     set searchdirn -backwards
4265     if {$searchstring ne {}} {
4266         set sel [$ctext tag ranges sel]
4267         if {$sel ne {}} {
4268             set start [lindex $sel 0]
4269         } elseif {[catch {set start [$ctext index anchor]}]} {
4270             set start @0,[winfo height $ctext]
4271         }
4272         set match [$ctext search -backwards -count ml -- $searchstring $start]
4273         $ctext tag remove sel 1.0 end
4274         if {$match eq {}} {
4275             bell
4276             return
4277         }
4278         $ctext see $match
4279         set mend "$match + $ml c"
4280         $ctext tag add sel $match $mend
4281         $ctext mark unset anchor
4282     }
4283 }
4284
4285 proc searchmark {first last} {
4286     global ctext searchstring
4287
4288     set mend $first.0
4289     while {1} {
4290         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4291         if {$match eq {}} break
4292         set mend "$match + $mlen c"
4293         $ctext tag add found $match $mend
4294     }
4295 }
4296
4297 proc searchmarkvisible {doall} {
4298     global ctext smarktop smarkbot
4299
4300     set topline [lindex [split [$ctext index @0,0] .] 0]
4301     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4302     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4303         # no overlap with previous
4304         searchmark $topline $botline
4305         set smarktop $topline
4306         set smarkbot $botline
4307     } else {
4308         if {$topline < $smarktop} {
4309             searchmark $topline [expr {$smarktop-1}]
4310             set smarktop $topline
4311         }
4312         if {$botline > $smarkbot} {
4313             searchmark [expr {$smarkbot+1}] $botline
4314             set smarkbot $botline
4315         }
4316     }
4317 }
4318
4319 proc scrolltext {f0 f1} {
4320     global searchstring
4321
4322     .ctop.cdet.left.sb set $f0 $f1
4323     if {$searchstring ne {}} {
4324         searchmarkvisible 0
4325     }
4326 }
4327
4328 proc setcoords {} {
4329     global linespc charspc canvx0 canvy0 mainfont
4330     global xspc1 xspc2 lthickness
4331
4332     set linespc [font metrics $mainfont -linespace]
4333     set charspc [font measure $mainfont "m"]
4334     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4335     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4336     set lthickness [expr {int($linespc / 9) + 1}]
4337     set xspc1(0) $linespc
4338     set xspc2 $linespc
4339 }
4340
4341 proc redisplay {} {
4342     global canv
4343     global selectedline
4344
4345     set ymax [lindex [$canv cget -scrollregion] 3]
4346     if {$ymax eq {} || $ymax == 0} return
4347     set span [$canv yview]
4348     clear_display
4349     setcanvscroll
4350     allcanvs yview moveto [lindex $span 0]
4351     drawvisible
4352     if {[info exists selectedline]} {
4353         selectline $selectedline 0
4354     }
4355 }
4356
4357 proc incrfont {inc} {
4358     global mainfont textfont ctext canv phase
4359     global stopped entries
4360     unmarkmatches
4361     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4362     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4363     setcoords
4364     $ctext conf -font $textfont
4365     $ctext tag conf filesep -font [concat $textfont bold]
4366     foreach e $entries {
4367         $e conf -font $mainfont
4368     }
4369     if {$phase eq "getcommits"} {
4370         $canv itemconf textitems -font $mainfont
4371     }
4372     redisplay
4373 }
4374
4375 proc clearsha1 {} {
4376     global sha1entry sha1string
4377     if {[string length $sha1string] == 40} {
4378         $sha1entry delete 0 end
4379     }
4380 }
4381
4382 proc sha1change {n1 n2 op} {
4383     global sha1string currentid sha1but
4384     if {$sha1string == {}
4385         || ([info exists currentid] && $sha1string == $currentid)} {
4386         set state disabled
4387     } else {
4388         set state normal
4389     }
4390     if {[$sha1but cget -state] == $state} return
4391     if {$state == "normal"} {
4392         $sha1but conf -state normal -relief raised -text "Goto: "
4393     } else {
4394         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4395     }
4396 }
4397
4398 proc gotocommit {} {
4399     global sha1string currentid commitrow tagids headids
4400     global displayorder numcommits curview
4401
4402     if {$sha1string == {}
4403         || ([info exists currentid] && $sha1string == $currentid)} return
4404     if {[info exists tagids($sha1string)]} {
4405         set id $tagids($sha1string)
4406     } elseif {[info exists headids($sha1string)]} {
4407         set id $headids($sha1string)
4408     } else {
4409         set id [string tolower $sha1string]
4410         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4411             set matches {}
4412             foreach i $displayorder {
4413                 if {[string match $id* $i]} {
4414                     lappend matches $i
4415                 }
4416             }
4417             if {$matches ne {}} {
4418                 if {[llength $matches] > 1} {
4419                     error_popup "Short SHA1 id $id is ambiguous"
4420                     return
4421                 }
4422                 set id [lindex $matches 0]
4423             }
4424         }
4425     }
4426     if {[info exists commitrow($curview,$id)]} {
4427         selectline $commitrow($curview,$id) 1
4428         return
4429     }
4430     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4431         set type "SHA1 id"
4432     } else {
4433         set type "Tag/Head"
4434     }
4435     error_popup "$type $sha1string is not known"
4436 }
4437
4438 proc lineenter {x y id} {
4439     global hoverx hovery hoverid hovertimer
4440     global commitinfo canv
4441
4442     if {![info exists commitinfo($id)] && ![getcommit $id]} return
4443     set hoverx $x
4444     set hovery $y
4445     set hoverid $id
4446     if {[info exists hovertimer]} {
4447         after cancel $hovertimer
4448     }
4449     set hovertimer [after 500 linehover]
4450     $canv delete hover
4451 }
4452
4453 proc linemotion {x y id} {
4454     global hoverx hovery hoverid hovertimer
4455
4456     if {[info exists hoverid] && $id == $hoverid} {
4457         set hoverx $x
4458         set hovery $y
4459         if {[info exists hovertimer]} {
4460             after cancel $hovertimer
4461         }
4462         set hovertimer [after 500 linehover]
4463     }
4464 }
4465
4466 proc lineleave {id} {
4467     global hoverid hovertimer canv
4468
4469     if {[info exists hoverid] && $id == $hoverid} {
4470         $canv delete hover
4471         if {[info exists hovertimer]} {
4472             after cancel $hovertimer
4473             unset hovertimer
4474         }
4475         unset hoverid
4476     }
4477 }
4478
4479 proc linehover {} {
4480     global hoverx hovery hoverid hovertimer
4481     global canv linespc lthickness
4482     global commitinfo mainfont
4483
4484     set text [lindex $commitinfo($hoverid) 0]
4485     set ymax [lindex [$canv cget -scrollregion] 3]
4486     if {$ymax == {}} return
4487     set yfrac [lindex [$canv yview] 0]
4488     set x [expr {$hoverx + 2 * $linespc}]
4489     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4490     set x0 [expr {$x - 2 * $lthickness}]
4491     set y0 [expr {$y - 2 * $lthickness}]
4492     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4493     set y1 [expr {$y + $linespc + 2 * $lthickness}]
4494     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4495                -fill \#ffff80 -outline black -width 1 -tags hover]
4496     $canv raise $t
4497     set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4498     $canv raise $t
4499 }
4500
4501 proc clickisonarrow {id y} {
4502     global lthickness
4503
4504     set ranges [rowranges $id]
4505     set thresh [expr {2 * $lthickness + 6}]
4506     set n [expr {[llength $ranges] - 1}]
4507     for {set i 1} {$i < $n} {incr i} {
4508         set row [lindex $ranges $i]
4509         if {abs([yc $row] - $y) < $thresh} {
4510             return $i
4511         }
4512     }
4513     return {}
4514 }
4515
4516 proc arrowjump {id n y} {
4517     global canv
4518
4519     # 1 <-> 2, 3 <-> 4, etc...
4520     set n [expr {(($n - 1) ^ 1) + 1}]
4521     set row [lindex [rowranges $id] $n]
4522     set yt [yc $row]
4523     set ymax [lindex [$canv cget -scrollregion] 3]
4524     if {$ymax eq {} || $ymax <= 0} return
4525     set view [$canv yview]
4526     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4527     set yfrac [expr {$yt / $ymax - $yspan / 2}]
4528     if {$yfrac < 0} {
4529         set yfrac 0
4530     }
4531     allcanvs yview moveto $yfrac
4532 }
4533
4534 proc lineclick {x y id isnew} {
4535     global ctext commitinfo children canv thickerline curview
4536
4537     if {![info exists commitinfo($id)] && ![getcommit $id]} return
4538     unmarkmatches
4539     unselectline
4540     normalline
4541     $canv delete hover
4542     # draw this line thicker than normal
4543     set thickerline $id
4544     drawlines $id
4545     if {$isnew} {
4546         set ymax [lindex [$canv cget -scrollregion] 3]
4547         if {$ymax eq {}} return
4548         set yfrac [lindex [$canv yview] 0]
4549         set y [expr {$y + $yfrac * $ymax}]
4550     }
4551     set dirn [clickisonarrow $id $y]
4552     if {$dirn ne {}} {
4553         arrowjump $id $dirn $y
4554         return
4555     }
4556
4557     if {$isnew} {
4558         addtohistory [list lineclick $x $y $id 0]
4559     }
4560     # fill the details pane with info about this line
4561     $ctext conf -state normal
4562     clear_ctext
4563     $ctext tag conf link -foreground blue -underline 1
4564     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4565     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4566     $ctext insert end "Parent:\t"
4567     $ctext insert end $id [list link link0]
4568     $ctext tag bind link0 <1> [list selbyid $id]
4569     set info $commitinfo($id)
4570     $ctext insert end "\n\t[lindex $info 0]\n"
4571     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4572     set date [formatdate [lindex $info 2]]
4573     $ctext insert end "\tDate:\t$date\n"
4574     set kids $children($curview,$id)
4575     if {$kids ne {}} {
4576         $ctext insert end "\nChildren:"
4577         set i 0
4578         foreach child $kids {
4579             incr i
4580             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4581             set info $commitinfo($child)
4582             $ctext insert end "\n\t"
4583             $ctext insert end $child [list link link$i]
4584             $ctext tag bind link$i <1> [list selbyid $child]
4585             $ctext insert end "\n\t[lindex $info 0]"
4586             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4587             set date [formatdate [lindex $info 2]]
4588             $ctext insert end "\n\tDate:\t$date\n"
4589         }
4590     }
4591     $ctext conf -state disabled
4592     init_flist {}
4593 }
4594
4595 proc normalline {} {
4596     global thickerline
4597     if {[info exists thickerline]} {
4598         set id $thickerline
4599         unset thickerline
4600         drawlines $id
4601     }
4602 }
4603
4604 proc selbyid {id} {
4605     global commitrow curview
4606     if {[info exists commitrow($curview,$id)]} {
4607         selectline $commitrow($curview,$id) 1
4608     }
4609 }
4610
4611 proc mstime {} {
4612     global startmstime
4613     if {![info exists startmstime]} {
4614         set startmstime [clock clicks -milliseconds]
4615     }
4616     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4617 }
4618
4619 proc rowmenu {x y id} {
4620     global rowctxmenu commitrow selectedline rowmenuid curview
4621
4622     if {![info exists selectedline]
4623         || $commitrow($curview,$id) eq $selectedline} {
4624         set state disabled
4625     } else {
4626         set state normal
4627     }
4628     $rowctxmenu entryconfigure 0 -state $state
4629     $rowctxmenu entryconfigure 1 -state $state
4630     $rowctxmenu entryconfigure 2 -state $state
4631     set rowmenuid $id
4632     tk_popup $rowctxmenu $x $y
4633 }
4634
4635 proc diffvssel {dirn} {
4636     global rowmenuid selectedline displayorder
4637
4638     if {![info exists selectedline]} return
4639     if {$dirn} {
4640         set oldid [lindex $displayorder $selectedline]
4641         set newid $rowmenuid
4642     } else {
4643         set oldid $rowmenuid
4644         set newid [lindex $displayorder $selectedline]
4645     }
4646     addtohistory [list doseldiff $oldid $newid]
4647     doseldiff $oldid $newid
4648 }
4649
4650 proc doseldiff {oldid newid} {
4651     global ctext
4652     global commitinfo
4653
4654     $ctext conf -state normal
4655     clear_ctext
4656     init_flist "Top"
4657     $ctext insert end "From "
4658     $ctext tag conf link -foreground blue -underline 1
4659     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4660     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4661     $ctext tag bind link0 <1> [list selbyid $oldid]
4662     $ctext insert end $oldid [list link link0]
4663     $ctext insert end "\n     "
4664     $ctext insert end [lindex $commitinfo($oldid) 0]
4665     $ctext insert end "\n\nTo   "
4666     $ctext tag bind link1 <1> [list selbyid $newid]
4667     $ctext insert end $newid [list link link1]
4668     $ctext insert end "\n     "
4669     $ctext insert end [lindex $commitinfo($newid) 0]
4670     $ctext insert end "\n"
4671     $ctext conf -state disabled
4672     $ctext tag delete Comments
4673     $ctext tag remove found 1.0 end
4674     startdiff [list $oldid $newid]
4675 }
4676
4677 proc mkpatch {} {
4678     global rowmenuid currentid commitinfo patchtop patchnum
4679
4680     if {![info exists currentid]} return
4681     set oldid $currentid
4682     set oldhead [lindex $commitinfo($oldid) 0]
4683     set newid $rowmenuid
4684     set newhead [lindex $commitinfo($newid) 0]
4685     set top .patch
4686     set patchtop $top
4687     catch {destroy $top}
4688     toplevel $top
4689     label $top.title -text "Generate patch"
4690     grid $top.title - -pady 10
4691     label $top.from -text "From:"
4692     entry $top.fromsha1 -width 40 -relief flat
4693     $top.fromsha1 insert 0 $oldid
4694     $top.fromsha1 conf -state readonly
4695     grid $top.from $top.fromsha1 -sticky w
4696     entry $top.fromhead -width 60 -relief flat
4697     $top.fromhead insert 0 $oldhead
4698     $top.fromhead conf -state readonly
4699     grid x $top.fromhead -sticky w
4700     label $top.to -text "To:"
4701     entry $top.tosha1 -width 40 -relief flat
4702     $top.tosha1 insert 0 $newid
4703     $top.tosha1 conf -state readonly
4704     grid $top.to $top.tosha1 -sticky w
4705     entry $top.tohead -width 60 -relief flat
4706     $top.tohead insert 0 $newhead
4707     $top.tohead conf -state readonly
4708     grid x $top.tohead -sticky w
4709     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4710     grid $top.rev x -pady 10
4711     label $top.flab -text "Output file:"
4712     entry $top.fname -width 60
4713     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4714     incr patchnum
4715     grid $top.flab $top.fname -sticky w
4716     frame $top.buts
4717     button $top.buts.gen -text "Generate" -command mkpatchgo
4718     button $top.buts.can -text "Cancel" -command mkpatchcan
4719     grid $top.buts.gen $top.buts.can
4720     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4721     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4722     grid $top.buts - -pady 10 -sticky ew
4723     focus $top.fname
4724 }
4725
4726 proc mkpatchrev {} {
4727     global patchtop
4728
4729     set oldid [$patchtop.fromsha1 get]
4730     set oldhead [$patchtop.fromhead get]
4731     set newid [$patchtop.tosha1 get]
4732     set newhead [$patchtop.tohead get]
4733     foreach e [list fromsha1 fromhead tosha1 tohead] \
4734             v [list $newid $newhead $oldid $oldhead] {
4735         $patchtop.$e conf -state normal
4736         $patchtop.$e delete 0 end
4737         $patchtop.$e insert 0 $v
4738         $patchtop.$e conf -state readonly
4739     }
4740 }
4741
4742 proc mkpatchgo {} {
4743     global patchtop
4744
4745     set oldid [$patchtop.fromsha1 get]
4746     set newid [$patchtop.tosha1 get]
4747     set fname [$patchtop.fname get]
4748     if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4749         error_popup "Error creating patch: $err"
4750     }
4751     catch {destroy $patchtop}
4752     unset patchtop
4753 }
4754
4755 proc mkpatchcan {} {
4756     global patchtop
4757
4758     catch {destroy $patchtop}
4759     unset patchtop
4760 }
4761
4762 proc mktag {} {
4763     global rowmenuid mktagtop commitinfo
4764
4765     set top .maketag
4766     set mktagtop $top
4767     catch {destroy $top}
4768     toplevel $top
4769     label $top.title -text "Create tag"
4770     grid $top.title - -pady 10
4771     label $top.id -text "ID:"
4772     entry $top.sha1 -width 40 -relief flat
4773     $top.sha1 insert 0 $rowmenuid
4774     $top.sha1 conf -state readonly
4775     grid $top.id $top.sha1 -sticky w
4776     entry $top.head -width 60 -relief flat
4777     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4778     $top.head conf -state readonly
4779     grid x $top.head -sticky w
4780     label $top.tlab -text "Tag name:"
4781     entry $top.tag -width 60
4782     grid $top.tlab $top.tag -sticky w
4783     frame $top.buts
4784     button $top.buts.gen -text "Create" -command mktaggo
4785     button $top.buts.can -text "Cancel" -command mktagcan
4786     grid $top.buts.gen $top.buts.can
4787     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4788     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4789     grid $top.buts - -pady 10 -sticky ew
4790     focus $top.tag
4791 }
4792
4793 proc domktag {} {
4794     global mktagtop env tagids idtags
4795
4796     set id [$mktagtop.sha1 get]
4797     set tag [$mktagtop.tag get]
4798     if {$tag == {}} {
4799         error_popup "No tag name specified"
4800         return
4801     }
4802     if {[info exists tagids($tag)]} {
4803         error_popup "Tag \"$tag\" already exists"
4804         return
4805     }
4806     if {[catch {
4807         set dir [gitdir]
4808         set fname [file join $dir "refs/tags" $tag]
4809         set f [open $fname w]
4810         puts $f $id
4811         close $f
4812     } err]} {
4813         error_popup "Error creating tag: $err"
4814         return
4815     }
4816
4817     set tagids($tag) $id
4818     lappend idtags($id) $tag
4819     redrawtags $id
4820 }
4821
4822 proc redrawtags {id} {
4823     global canv linehtag commitrow idpos selectedline curview
4824
4825     if {![info exists commitrow($curview,$id)]} return
4826     drawcmitrow $commitrow($curview,$id)
4827     $canv delete tag.$id
4828     set xt [eval drawtags $id $idpos($id)]
4829     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4830     if {[info exists selectedline]
4831         && $selectedline == $commitrow($curview,$id)} {
4832         selectline $selectedline 0
4833     }
4834 }
4835
4836 proc mktagcan {} {
4837     global mktagtop
4838
4839     catch {destroy $mktagtop}
4840     unset mktagtop
4841 }
4842
4843 proc mktaggo {} {
4844     domktag
4845     mktagcan
4846 }
4847
4848 proc writecommit {} {
4849     global rowmenuid wrcomtop commitinfo wrcomcmd
4850
4851     set top .writecommit
4852     set wrcomtop $top
4853     catch {destroy $top}
4854     toplevel $top
4855     label $top.title -text "Write commit to file"
4856     grid $top.title - -pady 10
4857     label $top.id -text "ID:"
4858     entry $top.sha1 -width 40 -relief flat
4859     $top.sha1 insert 0 $rowmenuid
4860     $top.sha1 conf -state readonly
4861     grid $top.id $top.sha1 -sticky w
4862     entry $top.head -width 60 -relief flat
4863     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4864     $top.head conf -state readonly
4865     grid x $top.head -sticky w
4866     label $top.clab -text "Command:"
4867     entry $top.cmd -width 60 -textvariable wrcomcmd
4868     grid $top.clab $top.cmd -sticky w -pady 10
4869     label $top.flab -text "Output file:"
4870     entry $top.fname -width 60
4871     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4872     grid $top.flab $top.fname -sticky w
4873     frame $top.buts
4874     button $top.buts.gen -text "Write" -command wrcomgo
4875     button $top.buts.can -text "Cancel" -command wrcomcan
4876     grid $top.buts.gen $top.buts.can
4877     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4878     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4879     grid $top.buts - -pady 10 -sticky ew
4880     focus $top.fname
4881 }
4882
4883 proc wrcomgo {} {
4884     global wrcomtop
4885
4886     set id [$wrcomtop.sha1 get]
4887     set cmd "echo $id | [$wrcomtop.cmd get]"
4888     set fname [$wrcomtop.fname get]
4889     if {[catch {exec sh -c $cmd >$fname &} err]} {
4890         error_popup "Error writing commit: $err"
4891     }
4892     catch {destroy $wrcomtop}
4893     unset wrcomtop
4894 }
4895
4896 proc wrcomcan {} {
4897     global wrcomtop
4898
4899     catch {destroy $wrcomtop}
4900     unset wrcomtop
4901 }
4902
4903 proc listrefs {id} {
4904     global idtags idheads idotherrefs
4905
4906     set x {}
4907     if {[info exists idtags($id)]} {
4908         set x $idtags($id)
4909     }
4910     set y {}
4911     if {[info exists idheads($id)]} {
4912         set y $idheads($id)
4913     }
4914     set z {}
4915     if {[info exists idotherrefs($id)]} {
4916         set z $idotherrefs($id)
4917     }
4918     return [list $x $y $z]
4919 }
4920
4921 proc rereadrefs {} {
4922     global idtags idheads idotherrefs
4923
4924     set refids [concat [array names idtags] \
4925                     [array names idheads] [array names idotherrefs]]
4926     foreach id $refids {
4927         if {![info exists ref($id)]} {
4928             set ref($id) [listrefs $id]
4929         }
4930     }
4931     readrefs
4932     set refids [lsort -unique [concat $refids [array names idtags] \
4933                         [array names idheads] [array names idotherrefs]]]
4934     foreach id $refids {
4935         set v [listrefs $id]
4936         if {![info exists ref($id)] || $ref($id) != $v} {
4937             redrawtags $id
4938         }
4939     }
4940 }
4941
4942 proc showtag {tag isnew} {
4943     global ctext tagcontents tagids linknum
4944
4945     if {$isnew} {
4946         addtohistory [list showtag $tag 0]
4947     }
4948     $ctext conf -state normal
4949     clear_ctext
4950     set linknum 0
4951     if {[info exists tagcontents($tag)]} {
4952         set text $tagcontents($tag)
4953     } else {
4954         set text "Tag: $tag\nId:  $tagids($tag)"
4955     }
4956     appendwithlinks $text
4957     $ctext conf -state disabled
4958     init_flist {}
4959 }
4960
4961 proc doquit {} {
4962     global stopped
4963     set stopped 100
4964     destroy .
4965 }
4966
4967 proc doprefs {} {
4968     global maxwidth maxgraphpct diffopts findmergefiles
4969     global oldprefs prefstop
4970
4971     set top .gitkprefs
4972     set prefstop $top
4973     if {[winfo exists $top]} {
4974         raise $top
4975         return
4976     }
4977     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4978         set oldprefs($v) [set $v]
4979     }
4980     toplevel $top
4981     wm title $top "Gitk preferences"
4982     label $top.ldisp -text "Commit list display options"
4983     grid $top.ldisp - -sticky w -pady 10
4984     label $top.spacer -text " "
4985     label $top.maxwidthl -text "Maximum graph width (lines)" \
4986         -font optionfont
4987     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4988     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4989     label $top.maxpctl -text "Maximum graph width (% of pane)" \
4990         -font optionfont
4991     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4992     grid x $top.maxpctl $top.maxpct -sticky w
4993     checkbutton $top.findm -variable findmergefiles
4994     label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
4995         -font optionfont
4996     grid $top.findm $top.findml - -sticky w
4997     label $top.ddisp -text "Diff display options"
4998     grid $top.ddisp - -sticky w -pady 10
4999     label $top.diffoptl -text "Options for diff program" \
5000         -font optionfont
5001     entry $top.diffopt -width 20 -textvariable diffopts
5002     grid x $top.diffoptl $top.diffopt -sticky w
5003     frame $top.buts
5004     button $top.buts.ok -text "OK" -command prefsok
5005     button $top.buts.can -text "Cancel" -command prefscan
5006     grid $top.buts.ok $top.buts.can
5007     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5008     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5009     grid $top.buts - - -pady 10 -sticky ew
5010 }
5011
5012 proc prefscan {} {
5013     global maxwidth maxgraphpct diffopts findmergefiles
5014     global oldprefs prefstop
5015
5016     foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
5017         set $v $oldprefs($v)
5018     }
5019     catch {destroy $prefstop}
5020     unset prefstop
5021 }
5022
5023 proc prefsok {} {
5024     global maxwidth maxgraphpct
5025     global oldprefs prefstop
5026
5027     catch {destroy $prefstop}
5028     unset prefstop
5029     if {$maxwidth != $oldprefs(maxwidth)
5030         || $maxgraphpct != $oldprefs(maxgraphpct)} {
5031         redisplay
5032     }
5033 }
5034
5035 proc formatdate {d} {
5036     return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5037 }
5038
5039 # This list of encoding names and aliases is distilled from
5040 # http://www.iana.org/assignments/character-sets.
5041 # Not all of them are supported by Tcl.
5042 set encoding_aliases {
5043     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5044       ISO646-US US-ASCII us IBM367 cp367 csASCII }
5045     { ISO-10646-UTF-1 csISO10646UTF1 }
5046     { ISO_646.basic:1983 ref csISO646basic1983 }
5047     { INVARIANT csINVARIANT }
5048     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5049     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5050     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5051     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5052     { NATS-DANO iso-ir-9-1 csNATSDANO }
5053     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5054     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5055     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5056     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5057     { ISO-2022-KR csISO2022KR }
5058     { EUC-KR csEUCKR }
5059     { ISO-2022-JP csISO2022JP }
5060     { ISO-2022-JP-2 csISO2022JP2 }
5061     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5062       csISO13JISC6220jp }
5063     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5064     { IT iso-ir-15 ISO646-IT csISO15Italian }
5065     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5066     { ES iso-ir-17 ISO646-ES csISO17Spanish }
5067     { greek7-old iso-ir-18 csISO18Greek7Old }
5068     { latin-greek iso-ir-19 csISO19LatinGreek }
5069     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5070     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5071     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5072     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5073     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5074     { BS_viewdata iso-ir-47 csISO47BSViewdata }
5075     { INIS iso-ir-49 csISO49INIS }
5076     { INIS-8 iso-ir-50 csISO50INIS8 }
5077     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5078     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5079     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5080     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5081     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5082     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5083       csISO60Norwegian1 }
5084     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5085     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5086     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5087     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5088     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5089     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5090     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5091     { greek7 iso-ir-88 csISO88Greek7 }
5092     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5093     { iso-ir-90 csISO90 }
5094     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5095     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5096       csISO92JISC62991984b }
5097     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5098     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5099     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5100       csISO95JIS62291984handadd }
5101     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5102     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5103     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5104     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5105       CP819 csISOLatin1 }
5106     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5107     { T.61-7bit iso-ir-102 csISO102T617bit }
5108     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5109     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5110     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5111     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5112     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5113     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5114     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5115     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5116       arabic csISOLatinArabic }
5117     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5118     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5119     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5120       greek greek8 csISOLatinGreek }
5121     { T.101-G2 iso-ir-128 csISO128T101G2 }
5122     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5123       csISOLatinHebrew }
5124     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5125     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5126     { CSN_369103 iso-ir-139 csISO139CSN369103 }
5127     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5128     { ISO_6937-2-add iso-ir-142 csISOTextComm }
5129     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5130     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5131       csISOLatinCyrillic }
5132     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5133     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5134     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5135     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5136     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5137     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5138     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5139     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5140     { ISO_10367-box iso-ir-155 csISO10367Box }
5141     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5142     { latin-lap lap iso-ir-158 csISO158Lap }
5143     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5144     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5145     { us-dk csUSDK }
5146     { dk-us csDKUS }
5147     { JIS_X0201 X0201 csHalfWidthKatakana }
5148     { KSC5636 ISO646-KR csKSC5636 }
5149     { ISO-10646-UCS-2 csUnicode }
5150     { ISO-10646-UCS-4 csUCS4 }
5151     { DEC-MCS dec csDECMCS }
5152     { hp-roman8 roman8 r8 csHPRoman8 }
5153     { macintosh mac csMacintosh }
5154     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5155       csIBM037 }
5156     { IBM038 EBCDIC-INT cp038 csIBM038 }
5157     { IBM273 CP273 csIBM273 }
5158     { IBM274 EBCDIC-BE CP274 csIBM274 }
5159     { IBM275 EBCDIC-BR cp275 csIBM275 }
5160     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5161     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5162     { IBM280 CP280 ebcdic-cp-it csIBM280 }
5163     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5164     { IBM284 CP284 ebcdic-cp-es csIBM284 }
5165     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5166     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5167     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5168     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5169     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5170     { IBM424 cp424 ebcdic-cp-he csIBM424 }
5171     { IBM437 cp437 437 csPC8CodePage437 }
5172     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5173     { IBM775 cp775 csPC775Baltic }
5174     { IBM850 cp850 850 csPC850Multilingual }
5175     { IBM851 cp851 851 csIBM851 }
5176     { IBM852 cp852 852 csPCp852 }
5177     { IBM855 cp855 855 csIBM855 }
5178     { IBM857 cp857 857 csIBM857 }
5179     { IBM860 cp860 860 csIBM860 }
5180     { IBM861 cp861 861 cp-is csIBM861 }
5181     { IBM862 cp862 862 csPC862LatinHebrew }
5182     { IBM863 cp863 863 csIBM863 }
5183     { IBM864 cp864 csIBM864 }
5184     { IBM865 cp865 865 csIBM865 }
5185     { IBM866 cp866 866 csIBM866 }
5186     { IBM868 CP868 cp-ar csIBM868 }
5187     { IBM869 cp869 869 cp-gr csIBM869 }
5188     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5189     { IBM871 CP871 ebcdic-cp-is csIBM871 }
5190     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5191     { IBM891 cp891 csIBM891 }
5192     { IBM903 cp903 csIBM903 }
5193     { IBM904 cp904 904 csIBBM904 }
5194     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5195     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5196     { IBM1026 CP1026 csIBM1026 }
5197     { EBCDIC-AT-DE csIBMEBCDICATDE }
5198     { EBCDIC-AT-DE-A csEBCDICATDEA }
5199     { EBCDIC-CA-FR csEBCDICCAFR }
5200     { EBCDIC-DK-NO csEBCDICDKNO }
5201     { EBCDIC-DK-NO-A csEBCDICDKNOA }
5202     { EBCDIC-FI-SE csEBCDICFISE }
5203     { EBCDIC-FI-SE-A csEBCDICFISEA }
5204     { EBCDIC-FR csEBCDICFR }
5205     { EBCDIC-IT csEBCDICIT }
5206     { EBCDIC-PT csEBCDICPT }
5207     { EBCDIC-ES csEBCDICES }
5208     { EBCDIC-ES-A csEBCDICESA }
5209     { EBCDIC-ES-S csEBCDICESS }
5210     { EBCDIC-UK csEBCDICUK }
5211     { EBCDIC-US csEBCDICUS }
5212     { UNKNOWN-8BIT csUnknown8BiT }
5213     { MNEMONIC csMnemonic }
5214     { MNEM csMnem }
5215     { VISCII csVISCII }
5216     { VIQR csVIQR }
5217     { KOI8-R csKOI8R }
5218     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5219     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5220     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5221     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5222     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5223     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5224     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5225     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5226     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5227     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5228     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5229     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5230     { IBM1047 IBM-1047 }
5231     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5232     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5233     { UNICODE-1-1 csUnicode11 }
5234     { CESU-8 csCESU-8 }
5235     { BOCU-1 csBOCU-1 }
5236     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5237     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5238       l8 }
5239     { ISO-8859-15 ISO_8859-15 Latin-9 }
5240     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5241     { GBK CP936 MS936 windows-936 }
5242     { JIS_Encoding csJISEncoding }
5243     { Shift_JIS MS_Kanji csShiftJIS }
5244     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5245       EUC-JP }
5246     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5247     { ISO-10646-UCS-Basic csUnicodeASCII }
5248     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5249     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5250     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5251     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5252     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5253     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5254     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5255     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5256     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5257     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5258     { Adobe-Standard-Encoding csAdobeStandardEncoding }
5259     { Ventura-US csVenturaUS }
5260     { Ventura-International csVenturaInternational }
5261     { PC8-Danish-Norwegian csPC8DanishNorwegian }
5262     { PC8-Turkish csPC8Turkish }
5263     { IBM-Symbols csIBMSymbols }
5264     { IBM-Thai csIBMThai }
5265     { HP-Legal csHPLegal }
5266     { HP-Pi-font csHPPiFont }
5267     { HP-Math8 csHPMath8 }
5268     { Adobe-Symbol-Encoding csHPPSMath }
5269     { HP-DeskTop csHPDesktop }
5270     { Ventura-Math csVenturaMath }
5271     { Microsoft-Publishing csMicrosoftPublishing }
5272     { Windows-31J csWindows31J }
5273     { GB2312 csGB2312 }
5274     { Big5 csBig5 }
5275 }
5276
5277 proc tcl_encoding {enc} {
5278     global encoding_aliases
5279     set names [encoding names]
5280     set lcnames [string tolower $names]
5281     set enc [string tolower $enc]
5282     set i [lsearch -exact $lcnames $enc]
5283     if {$i < 0} {
5284         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5285         if {[regsub {^iso[-_]} $enc iso encx]} {
5286             set i [lsearch -exact $lcnames $encx]
5287         }
5288     }
5289     if {$i < 0} {
5290         foreach l $encoding_aliases {
5291             set ll [string tolower $l]
5292             if {[lsearch -exact $ll $enc] < 0} continue
5293             # look through the aliases for one that tcl knows about
5294             foreach e $ll {
5295                 set i [lsearch -exact $lcnames $e]
5296                 if {$i < 0} {
5297                     if {[regsub {^iso[-_]} $e iso ex]} {
5298                         set i [lsearch -exact $lcnames $ex]
5299                     }
5300                 }
5301                 if {$i >= 0} break
5302             }
5303             break
5304         }
5305     }
5306     if {$i >= 0} {
5307         return [lindex $names $i]
5308     }
5309     return {}
5310 }
5311
5312 # defaults...
5313 set datemode 0
5314 set diffopts "-U 5 -p"
5315 set wrcomcmd "git-diff-tree --stdin -p --pretty"
5316
5317 set gitencoding {}
5318 catch {
5319     set gitencoding [exec git-repo-config --get i18n.commitencoding]
5320 }
5321 if {$gitencoding == ""} {
5322     set gitencoding "utf-8"
5323 }
5324 set tclencoding [tcl_encoding $gitencoding]
5325 if {$tclencoding == {}} {
5326     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5327 }
5328
5329 set mainfont {Helvetica 9}
5330 set textfont {Courier 9}
5331 set uifont {Helvetica 9 bold}
5332 set findmergefiles 0
5333 set maxgraphpct 50
5334 set maxwidth 16
5335 set revlistorder 0
5336 set fastdate 0
5337 set uparrowlen 7
5338 set downarrowlen 7
5339 set mingaplen 30
5340 set cmitmode "patch"
5341
5342 set colors {green red blue magenta darkgrey brown orange}
5343
5344 catch {source ~/.gitk}
5345
5346 font create optionfont -family sans-serif -size -12
5347
5348 set revtreeargs {}
5349 foreach arg $argv {
5350     switch -regexp -- $arg {
5351         "^$" { }
5352         "^-d" { set datemode 1 }
5353         default {
5354             lappend revtreeargs $arg
5355         }
5356     }
5357 }
5358
5359 # check that we can find a .git directory somewhere...
5360 set gitdir [gitdir]
5361 if {![file isdirectory $gitdir]} {
5362     show_error . "Cannot find the git directory \"$gitdir\"."
5363     exit 1
5364 }
5365
5366 set cmdline_files {}
5367 set i [lsearch -exact $revtreeargs "--"]
5368 if {$i >= 0} {
5369     set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5370     set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5371 } elseif {$revtreeargs ne {}} {
5372     if {[catch {
5373         set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
5374         set cmdline_files [split $f "\n"]
5375         set n [llength $cmdline_files]
5376         set revtreeargs [lrange $revtreeargs 0 end-$n]
5377     } err]} {
5378         # unfortunately we get both stdout and stderr in $err,
5379         # so look for "fatal:".
5380         set i [string first "fatal:" $err]
5381         if {$i > 0} {
5382             set err [string range [expr {$i + 6}] end]
5383         }
5384         show_error . "Bad arguments to gitk:\n$err"
5385         exit 1
5386     }
5387 }
5388
5389 set history {}
5390 set historyindex 0
5391 set fh_serial 0
5392 set highlight_names {}
5393 set nhl_names {}
5394 set highlight_paths {}
5395 set searchdirn -forwards
5396
5397 set optim_delay 16
5398
5399 set nextviewnum 1
5400 set curview 0
5401 set selectedview 0
5402 set selectedhlview None
5403 set viewfiles(0) {}
5404 set viewperm(0) 0
5405 set viewargs(0) {}
5406
5407 set cmdlineok 0
5408 set stopped 0
5409 set stuffsaved 0
5410 set patchnum 0
5411 setcoords
5412 makewindow
5413 readrefs
5414
5415 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5416     # create a view for the files/dirs specified on the command line
5417     set curview 1
5418     set selectedview 1
5419     set nextviewnum 2
5420     set viewname(1) "Command line"
5421     set viewfiles(1) $cmdline_files
5422     set viewargs(1) $revtreeargs
5423     set viewperm(1) 0
5424     addviewmenu 1
5425     .bar.view entryconf 2 -state normal
5426     .bar.view entryconf 3 -state normal
5427 }
5428
5429 if {[info exists permviews]} {
5430     foreach v $permviews {
5431         set n $nextviewnum
5432         incr nextviewnum
5433         set viewname($n) [lindex $v 0]
5434         set viewfiles($n) [lindex $v 1]
5435         set viewargs($n) [lindex $v 2]
5436         set viewperm($n) 1
5437         addviewmenu $n
5438     }
5439 }
5440 getcommits