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