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