gitk

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