gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright (C) 2005-2006 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 [exec git rev-parse --git-dir]
  16     }
  17 }
  18
  19 # A simple scheduler for compute-intensive stuff.
  20 # The aim is to make sure that event handlers for GUI actions can
  21 # run at least every 50-100 ms.  Unfortunately fileevent handlers are
  22 # run before X event handlers, so reading from a fast source can
  23 # make the GUI completely unresponsive.
  24 proc run args {
  25     global isonrunq runq
  26
  27     set script $args
  28     if {[info exists isonrunq($script)]} return
  29     if {$runq eq {}} {
  30         after idle dorunq
  31     }
  32     lappend runq [list {} $script]
  33     set isonrunq($script) 1
  34 }
  35
  36 proc filerun {fd script} {
  37     fileevent $fd readable [list filereadable $fd $script]
  38 }
  39
  40 proc filereadable {fd script} {
  41     global runq
  42
  43     fileevent $fd readable {}
  44     if {$runq eq {}} {
  45         after idle dorunq
  46     }
  47     lappend runq [list $fd $script]
  48 }
  49
  50 proc dorunq {} {
  51     global isonrunq runq
  52
  53     set tstart [clock clicks -milliseconds]
  54     set t0 $tstart
  55     while {$runq ne {}} {
  56         set fd [lindex $runq 0 0]
  57         set script [lindex $runq 0 1]
  58         set repeat [eval $script]
  59         set t1 [clock clicks -milliseconds]
  60         set t [expr {$t1 - $t0}]
  61         set runq [lrange $runq 1 end]
  62         if {$repeat ne {} && $repeat} {
  63             if {$fd eq {} || $repeat == 2} {
  64                 # script returns 1 if it wants to be readded
  65                 # file readers return 2 if they could do more straight away
  66                 lappend runq [list $fd $script]
  67             } else {
  68                 fileevent $fd readable [list filereadable $fd $script]
  69             }
  70         } elseif {$fd eq {}} {
  71             unset isonrunq($script)
  72         }
  73         set t0 $t1
  74         if {$t1 - $tstart >= 80} break
  75     }
  76     if {$runq ne {}} {
  77         after idle dorunq
  78     }
  79 }
  80
  81 # Start off a git rev-list process and arrange to read its output
  82 proc start_rev_list {view} {
  83     global startmsecs
  84     global commfd leftover tclencoding datemode
  85     global viewargs viewfiles commitidx vnextroot
  86     global lookingforhead showlocalchanges
  87
  88     set startmsecs [clock clicks -milliseconds]
  89     set commitidx($view) 0
  90     set vnextroot($view) 0
  91     set order "--topo-order"
  92     if {$datemode} {
  93         set order "--date-order"
  94     }
  95     if {[catch {
  96         set fd [open [concat | git log -z --pretty=raw $order --parents \
  97                          --boundary $viewargs($view) "--" $viewfiles($view)] r]
  98     } err]} {
  99         error_popup "Error executing git rev-list: $err"
 100         exit 1
 101     }
 102     set commfd($view) $fd
 103     set leftover($view) {}
 104     set lookingforhead $showlocalchanges
 105     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 106     if {$tclencoding != {}} {
 107         fconfigure $fd -encoding $tclencoding
 108     }
 109     filerun $fd [list getcommitlines $fd $view]
 110     nowbusy $view
 111 }
 112
 113 proc stop_rev_list {} {
 114     global commfd curview
 115
 116     if {![info exists commfd($curview)]} return
 117     set fd $commfd($curview)
 118     catch {
 119         set pid [pid $fd]
 120         exec kill $pid
 121     }
 122     catch {close $fd}
 123     unset commfd($curview)
 124 }
 125
 126 proc getcommits {} {
 127     global phase canv mainfont curview
 128
 129     set phase getcommits
 130     initlayout
 131     start_rev_list $curview
 132     show_status "Reading commits..."
 133 }
 134
 135 # This makes a string representation of a positive integer which
 136 # sorts as a string in numerical order
 137 proc strrep {n} {
 138     if {$n < 16} {
 139         return [format "%x" $n]
 140     } elseif {$n < 256} {
 141         return [format "x%.2x" $n]
 142     } elseif {$n < 65536} {
 143         return [format "y%.4x" $n]
 144     }
 145     return [format "z%.8x" $n]
 146 }
 147
 148 proc getcommitlines {fd view}  {
 149     global commitlisted
 150     global leftover commfd
 151     global displayorder commitidx commitrow commitdata
 152     global parentlist children curview hlview
 153     global vparentlist vdisporder vcmitlisted
 154     global ordertok vnextroot idpending
 155
 156     set stuff [read $fd 500000]
 157     # git log doesn't terminate the last commit with a null...
 158     if {$stuff == {} && $leftover($view) ne {} && [eof $fd]} {
 159         set stuff "\0"
 160     }
 161     if {$stuff == {}} {
 162         if {![eof $fd]} {
 163             return 1
 164         }
 165         # Check if we have seen any ids listed as parents that haven't
 166         # appeared in the list
 167         foreach vid [array names idpending "$view,*"] {
 168             # should only get here if git log is buggy
 169             set id [lindex [split $vid ","] 1]
 170             set commitrow($vid) $commitidx($view)
 171             incr commitidx($view)
 172             if {$view == $curview} {
 173                 lappend parentlist {}
 174                 lappend displayorder $id
 175                 lappend commitlisted 0
 176             } else {
 177                 lappend vparentlist($view) {}
 178                 lappend vdisporder($view) $id
 179                 lappend vcmitlisted($view) 0
 180             }
 181         }
 182         global viewname
 183         unset commfd($view)
 184         notbusy $view
 185         # set it blocking so we wait for the process to terminate
 186         fconfigure $fd -blocking 1
 187         if {[catch {close $fd} err]} {
 188             set fv {}
 189             if {$view != $curview} {
 190                 set fv " for the \"$viewname($view)\" view"
 191             }
 192             if {[string range $err 0 4] == "usage"} {
 193                 set err "Gitk: error reading commits$fv:\
 194                         bad arguments to git rev-list."
 195                 if {$viewname($view) eq "Command line"} {
 196                     append err \
 197                         "  (Note: arguments to gitk are passed to git rev-list\
 198                          to allow selection of commits to be displayed.)"
 199                 }
 200             } else {
 201                 set err "Error reading commits$fv: $err"
 202             }
 203             error_popup $err
 204         }
 205         if {$view == $curview} {
 206             run chewcommits $view
 207         }
 208         return 0
 209     }
 210     set start 0
 211     set gotsome 0
 212     while 1 {
 213         set i [string first "\0" $stuff $start]
 214         if {$i < 0} {
 215             append leftover($view) [string range $stuff $start end]
 216             break
 217         }
 218         if {$start == 0} {
 219             set cmit $leftover($view)
 220             append cmit [string range $stuff 0 [expr {$i - 1}]]
 221             set leftover($view) {}
 222         } else {
 223             set cmit [string range $stuff $start [expr {$i - 1}]]
 224         }
 225         set start [expr {$i + 1}]
 226         set j [string first "\n" $cmit]
 227         set ok 0
 228         set listed 1
 229         if {$j >= 0 && [string match "commit *" $cmit]} {
 230             set ids [string range $cmit 7 [expr {$j - 1}]]
 231             if {[string match {[-<>]*} $ids]} {
 232                 switch -- [string index $ids 0] {
 233                     "-" {set listed 0}
 234                     "<" {set listed 2}
 235                     ">" {set listed 3}
 236                 }
 237                 set ids [string range $ids 1 end]
 238             }
 239             set ok 1
 240             foreach id $ids {
 241                 if {[string length $id] != 40} {
 242                     set ok 0
 243                     break
 244                 }
 245             }
 246         }
 247         if {!$ok} {
 248             set shortcmit $cmit
 249             if {[string length $shortcmit] > 80} {
 250                 set shortcmit "[string range $shortcmit 0 80]..."
 251             }
 252             error_popup "Can't parse git log output: {$shortcmit}"
 253             exit 1
 254         }
 255         set id [lindex $ids 0]
 256         if {![info exists ordertok($view,$id)]} {
 257             set otok "o[strrep $vnextroot($view)]"
 258             incr vnextroot($view)
 259             set ordertok($view,$id) $otok
 260         } else {
 261             set otok $ordertok($view,$id)
 262             unset idpending($view,$id)
 263         }
 264         if {$listed} {
 265             set olds [lrange $ids 1 end]
 266             if {[llength $olds] == 1} {
 267                 set p [lindex $olds 0]
 268                 lappend children($view,$p) $id
 269                 if {![info exists ordertok($view,$p)]} {
 270                     set ordertok($view,$p) $ordertok($view,$id)
 271                     set idpending($view,$p) 1
 272                 }
 273             } else {
 274                 set i 0
 275                 foreach p $olds {
 276                     if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
 277                         lappend children($view,$p) $id
 278                     }
 279                     if {![info exists ordertok($view,$p)]} {
 280                         set ordertok($view,$p) "$otok[strrep $i]]"
 281                         set idpending($view,$p) 1
 282                     }
 283                     incr i
 284                 }
 285             }
 286         } else {
 287             set olds {}
 288         }
 289         if {![info exists children($view,$id)]} {
 290             set children($view,$id) {}
 291         }
 292         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
 293         set commitrow($view,$id) $commitidx($view)
 294         incr commitidx($view)
 295         if {$view == $curview} {
 296             lappend parentlist $olds
 297             lappend displayorder $id
 298             lappend commitlisted $listed
 299         } else {
 300             lappend vparentlist($view) $olds
 301             lappend vdisporder($view) $id
 302             lappend vcmitlisted($view) $listed
 303         }
 304         set gotsome 1
 305     }
 306     if {$gotsome} {
 307         run chewcommits $view
 308     }
 309     return 2
 310 }
 311
 312 proc chewcommits {view} {
 313     global curview hlview commfd
 314     global selectedline pending_select
 315
 316     set more 0
 317     if {$view == $curview} {
 318         set allread [expr {![info exists commfd($view)]}]
 319         set tlimit [expr {[clock clicks -milliseconds] + 50}]
 320         set more [layoutmore $tlimit $allread]
 321         if {$allread && !$more} {
 322             global displayorder commitidx phase
 323             global numcommits startmsecs
 324
 325             if {[info exists pending_select]} {
 326                 set row [first_real_row]
 327                 selectline $row 1
 328             }
 329             if {$commitidx($curview) > 0} {
 330                 #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
 331                 #puts "overall $ms ms for $numcommits commits"
 332             } else {
 333                 show_status "No commits selected"
 334             }
 335             notbusy layout
 336             set phase {}
 337         }
 338     }
 339     if {[info exists hlview] && $view == $hlview} {
 340         vhighlightmore
 341     }
 342     return $more
 343 }
 344
 345 proc readcommit {id} {
 346     if {[catch {set contents [exec git cat-file commit $id]}]} return
 347     parsecommit $id $contents 0
 348 }
 349
 350 proc updatecommits {} {
 351     global viewdata curview phase displayorder ordertok idpending
 352     global children commitrow selectedline thickerline showneartags
 353
 354     if {$phase ne {}} {
 355         stop_rev_list
 356         set phase {}
 357     }
 358     set n $curview
 359     foreach id $displayorder {
 360         catch {unset children($n,$id)}
 361         catch {unset commitrow($n,$id)}
 362         catch {unset ordertok($n,$id)}
 363     }
 364     foreach vid [array names idpending "$n,*"] {
 365         unset idpending($vid)
 366     }
 367     set curview -1
 368     catch {unset selectedline}
 369     catch {unset thickerline}
 370     catch {unset viewdata($n)}
 371     readrefs
 372     changedrefs
 373     if {$showneartags} {
 374         getallcommits
 375     }
 376     showview $n
 377 }
 378
 379 proc parsecommit {id contents listed} {
 380     global commitinfo cdate
 381
 382     set inhdr 1
 383     set comment {}
 384     set headline {}
 385     set auname {}
 386     set audate {}
 387     set comname {}
 388     set comdate {}
 389     set hdrend [string first "\n\n" $contents]
 390     if {$hdrend < 0} {
 391         # should never happen...
 392         set hdrend [string length $contents]
 393     }
 394     set header [string range $contents 0 [expr {$hdrend - 1}]]
 395     set comment [string range $contents [expr {$hdrend + 2}] end]
 396     foreach line [split $header "\n"] {
 397         set tag [lindex $line 0]
 398         if {$tag == "author"} {
 399             set audate [lindex $line end-1]
 400             set auname [lrange $line 1 end-2]
 401         } elseif {$tag == "committer"} {
 402             set comdate [lindex $line end-1]
 403             set comname [lrange $line 1 end-2]
 404         }
 405     }
 406     set headline {}
 407     # take the first non-blank line of the comment as the headline
 408     set headline [string trimleft $comment]
 409     set i [string first "\n" $headline]
 410     if {$i >= 0} {
 411         set headline [string range $headline 0 $i]
 412     }
 413     set headline [string trimright $headline]
 414     set i [string first "\r" $headline]
 415     if {$i >= 0} {
 416         set headline [string trimright [string range $headline 0 $i]]
 417     }
 418     if {!$listed} {
 419         # git rev-list indents the comment by 4 spaces;
 420         # if we got this via git cat-file, add the indentation
 421         set newcomment {}
 422         foreach line [split $comment "\n"] {
 423             append newcomment "    "
 424             append newcomment $line
 425             append newcomment "\n"
 426         }
 427         set comment $newcomment
 428     }
 429     if {$comdate != {}} {
 430         set cdate($id) $comdate
 431     }
 432     set commitinfo($id) [list $headline $auname $audate \
 433                              $comname $comdate $comment]
 434 }
 435
 436 proc getcommit {id} {
 437     global commitdata commitinfo
 438
 439     if {[info exists commitdata($id)]} {
 440         parsecommit $id $commitdata($id) 1
 441     } else {
 442         readcommit $id
 443         if {![info exists commitinfo($id)]} {
 444             set commitinfo($id) {"No commit information available"}
 445         }
 446     }
 447     return 1
 448 }
 449
 450 proc readrefs {} {
 451     global tagids idtags headids idheads tagobjid
 452     global otherrefids idotherrefs mainhead mainheadid
 453
 454     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
 455         catch {unset $v}
 456     }
 457     set refd [open [list | git show-ref -d] r]
 458     while {[gets $refd line] >= 0} {
 459         if {[string index $line 40] ne " "} continue
 460         set id [string range $line 0 39]
 461         set ref [string range $line 41 end]
 462         if {![string match "refs/*" $ref]} continue
 463         set name [string range $ref 5 end]
 464         if {[string match "remotes/*" $name]} {
 465             if {![string match "*/HEAD" $name]} {
 466                 set headids($name) $id
 467                 lappend idheads($id) $name
 468             }
 469         } elseif {[string match "heads/*" $name]} {
 470             set name [string range $name 6 end]
 471             set headids($name) $id
 472             lappend idheads($id) $name
 473         } elseif {[string match "tags/*" $name]} {
 474             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
 475             # which is what we want since the former is the commit ID
 476             set name [string range $name 5 end]
 477             if {[string match "*^{}" $name]} {
 478                 set name [string range $name 0 end-3]
 479             } else {
 480                 set tagobjid($name) $id
 481             }
 482             set tagids($name) $id
 483             lappend idtags($id) $name
 484         } else {
 485             set otherrefids($name) $id
 486             lappend idotherrefs($id) $name
 487         }
 488     }
 489     catch {close $refd}
 490     set mainhead {}
 491     set mainheadid {}
 492     catch {
 493         set thehead [exec git symbolic-ref HEAD]
 494         if {[string match "refs/heads/*" $thehead]} {
 495             set mainhead [string range $thehead 11 end]
 496             if {[info exists headids($mainhead)]} {
 497                 set mainheadid $headids($mainhead)
 498             }
 499         }
 500     }
 501 }
 502
 503 # skip over fake commits
 504 proc first_real_row {} {
 505     global nullid nullid2 displayorder numcommits
 506
 507     for {set row 0} {$row < $numcommits} {incr row} {
 508         set id [lindex $displayorder $row]
 509         if {$id ne $nullid && $id ne $nullid2} {
 510             break
 511         }
 512     }
 513     return $row
 514 }
 515
 516 # update things for a head moved to a child of its previous location
 517 proc movehead {id name} {
 518     global headids idheads
 519
 520     removehead $headids($name) $name
 521     set headids($name) $id
 522     lappend idheads($id) $name
 523 }
 524
 525 # update things when a head has been removed
 526 proc removehead {id name} {
 527     global headids idheads
 528
 529     if {$idheads($id) eq $name} {
 530         unset idheads($id)
 531     } else {
 532         set i [lsearch -exact $idheads($id) $name]
 533         if {$i >= 0} {
 534             set idheads($id) [lreplace $idheads($id) $i $i]
 535         }
 536     }
 537     unset headids($name)
 538 }
 539
 540 proc show_error {w top msg} {
 541     message $w.m -text $msg -justify center -aspect 400
 542     pack $w.m -side top -fill x -padx 20 -pady 20
 543     button $w.ok -text OK -command "destroy $top"
 544     pack $w.ok -side bottom -fill x
 545     bind $top <Visibility> "grab $top; focus $top"
 546     bind $top <Key-Return> "destroy $top"
 547     tkwait window $top
 548 }
 549
 550 proc error_popup msg {
 551     set w .error
 552     toplevel $w
 553     wm transient $w .
 554     show_error $w $w $msg
 555 }
 556
 557 proc confirm_popup msg {
 558     global confirm_ok
 559     set confirm_ok 0
 560     set w .confirm
 561     toplevel $w
 562     wm transient $w .
 563     message $w.m -text $msg -justify center -aspect 400
 564     pack $w.m -side top -fill x -padx 20 -pady 20
 565     button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
 566     pack $w.ok -side left -fill x
 567     button $w.cancel -text Cancel -command "destroy $w"
 568     pack $w.cancel -side right -fill x
 569     bind $w <Visibility> "grab $w; focus $w"
 570     tkwait window $w
 571     return $confirm_ok
 572 }
 573
 574 proc makewindow {} {
 575     global canv canv2 canv3 linespc charspc ctext cflist
 576     global textfont mainfont uifont tabstop
 577     global findtype findtypemenu findloc findstring fstring geometry
 578     global entries sha1entry sha1string sha1but
 579     global diffcontextstring diffcontext
 580     global maincursor textcursor curtextcursor
 581     global rowctxmenu fakerowmenu mergemax wrapcomment
 582     global highlight_files gdttype
 583     global searchstring sstring
 584     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
 585     global headctxmenu
 586
 587     menu .bar
 588     .bar add cascade -label "File" -menu .bar.file
 589     .bar configure -font $uifont
 590     menu .bar.file
 591     .bar.file add command -label "Update" -command updatecommits
 592     .bar.file add command -label "Reread references" -command rereadrefs
 593     .bar.file add command -label "List references" -command showrefs
 594     .bar.file add command -label "Quit" -command doquit
 595     .bar.file configure -font $uifont
 596     menu .bar.edit
 597     .bar add cascade -label "Edit" -menu .bar.edit
 598     .bar.edit add command -label "Preferences" -command doprefs
 599     .bar.edit configure -font $uifont
 600
 601     menu .bar.view -font $uifont
 602     .bar add cascade -label "View" -menu .bar.view
 603     .bar.view add command -label "New view..." -command {newview 0}
 604     .bar.view add command -label "Edit view..." -command editview \
 605         -state disabled
 606     .bar.view add command -label "Delete view" -command delview -state disabled
 607     .bar.view add separator
 608     .bar.view add radiobutton -label "All files" -command {showview 0} \
 609         -variable selectedview -value 0
 610
 611     menu .bar.help
 612     .bar add cascade -label "Help" -menu .bar.help
 613     .bar.help add command -label "About gitk" -command about
 614     .bar.help add command -label "Key bindings" -command keys
 615     .bar.help configure -font $uifont
 616     . configure -menu .bar
 617
 618     # the gui has upper and lower half, parts of a paned window.
 619     panedwindow .ctop -orient vertical
 620
 621     # possibly use assumed geometry
 622     if {![info exists geometry(pwsash0)]} {
 623         set geometry(topheight) [expr {15 * $linespc}]
 624         set geometry(topwidth) [expr {80 * $charspc}]
 625         set geometry(botheight) [expr {15 * $linespc}]
 626         set geometry(botwidth) [expr {50 * $charspc}]
 627         set geometry(pwsash0) "[expr {40 * $charspc}] 2"
 628         set geometry(pwsash1) "[expr {60 * $charspc}] 2"
 629     }
 630
 631     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
 632     frame .tf -height $geometry(topheight) -width $geometry(topwidth)
 633     frame .tf.histframe
 634     panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4
 635
 636     # create three canvases
 637     set cscroll .tf.histframe.csb
 638     set canv .tf.histframe.pwclist.canv
 639     canvas $canv \
 640         -selectbackground $selectbgcolor \
 641         -background $bgcolor -bd 0 \
 642         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
 643     .tf.histframe.pwclist add $canv
 644     set canv2 .tf.histframe.pwclist.canv2
 645     canvas $canv2 \
 646         -selectbackground $selectbgcolor \
 647         -background $bgcolor -bd 0 -yscrollincr $linespc
 648     .tf.histframe.pwclist add $canv2
 649     set canv3 .tf.histframe.pwclist.canv3
 650     canvas $canv3 \
 651         -selectbackground $selectbgcolor \
 652         -background $bgcolor -bd 0 -yscrollincr $linespc
 653     .tf.histframe.pwclist add $canv3
 654     eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
 655     eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
 656
 657     # a scroll bar to rule them
 658     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 659     pack $cscroll -side right -fill y
 660     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
 661     lappend bglist $canv $canv2 $canv3
 662     pack .tf.histframe.pwclist -fill both -expand 1 -side left
 663
 664     # we have two button bars at bottom of top frame. Bar 1
 665     frame .tf.bar
 666     frame .tf.lbar -height 15
 667
 668     set sha1entry .tf.bar.sha1
 669     set entries $sha1entry
 670     set sha1but .tf.bar.sha1label
 671     button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 672         -command gotocommit -width 8 -font $uifont
 673     $sha1but conf -disabledforeground [$sha1but cget -foreground]
 674     pack .tf.bar.sha1label -side left
 675     entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 676     trace add variable sha1string write sha1change
 677     pack $sha1entry -side left -pady 2
 678
 679     image create bitmap bm-left -data {
 680         #define left_width 16
 681         #define left_height 16
 682         static unsigned char left_bits[] = {
 683         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 684         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 685         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 686     }
 687     image create bitmap bm-right -data {
 688         #define right_width 16
 689         #define right_height 16
 690         static unsigned char right_bits[] = {
 691         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 692         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 693         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 694     }
 695     button .tf.bar.leftbut -image bm-left -command goback \
 696         -state disabled -width 26
 697     pack .tf.bar.leftbut -side left -fill y
 698     button .tf.bar.rightbut -image bm-right -command goforw \
 699         -state disabled -width 26
 700     pack .tf.bar.rightbut -side left -fill y
 701
 702     button .tf.bar.findbut -text "Find" -command dofind -font $uifont
 703     pack .tf.bar.findbut -side left
 704     set findstring {}
 705     set fstring .tf.bar.findstring
 706     lappend entries $fstring
 707     entry $fstring -width 30 -font $textfont -textvariable findstring
 708     trace add variable findstring write find_change
 709     pack $fstring -side left -expand 1 -fill x -in .tf.bar
 710     set findtype Exact
 711     set findtypemenu [tk_optionMenu .tf.bar.findtype \
 712                       findtype Exact IgnCase Regexp]
 713     trace add variable findtype write find_change
 714     .tf.bar.findtype configure -font $uifont
 715     .tf.bar.findtype.menu configure -font $uifont
 716     set findloc "All fields"
 717     tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
 718         Comments Author Committer
 719     trace add variable findloc write find_change
 720     .tf.bar.findloc configure -font $uifont
 721     .tf.bar.findloc.menu configure -font $uifont
 722     pack .tf.bar.findloc -side right
 723     pack .tf.bar.findtype -side right
 724
 725     # build up the bottom bar of upper window
 726     label .tf.lbar.flabel -text "Highlight:  Commits " \
 727     -font $uifont
 728     pack .tf.lbar.flabel -side left -fill y
 729     set gdttype "touching paths:"
 730     set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
 731         "adding/removing string:"]
 732     trace add variable gdttype write hfiles_change
 733     $gm conf -font $uifont
 734     .tf.lbar.gdttype conf -font $uifont
 735     pack .tf.lbar.gdttype -side left -fill y
 736     entry .tf.lbar.fent -width 25 -font $textfont \
 737         -textvariable highlight_files
 738     trace add variable highlight_files write hfiles_change
 739     lappend entries .tf.lbar.fent
 740     pack .tf.lbar.fent -side left -fill x -expand 1
 741     label .tf.lbar.vlabel -text " OR in view" -font $uifont
 742     pack .tf.lbar.vlabel -side left -fill y
 743     global viewhlmenu selectedhlview
 744     set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
 745     $viewhlmenu entryconf None -command delvhighlight
 746     $viewhlmenu conf -font $uifont
 747     .tf.lbar.vhl conf -font $uifont
 748     pack .tf.lbar.vhl -side left -fill y
 749     label .tf.lbar.rlabel -text " OR " -font $uifont
 750     pack .tf.lbar.rlabel -side left -fill y
 751     global highlight_related
 752     set m [tk_optionMenu .tf.lbar.relm highlight_related None \
 753         "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
 754     $m conf -font $uifont
 755     .tf.lbar.relm conf -font $uifont
 756     trace add variable highlight_related write vrel_change
 757     pack .tf.lbar.relm -side left -fill y
 758
 759     # Finish putting the upper half of the viewer together
 760     pack .tf.lbar -in .tf -side bottom -fill x
 761     pack .tf.bar -in .tf -side bottom -fill x
 762     pack .tf.histframe -fill both -side top -expand 1
 763     .ctop add .tf
 764     .ctop paneconfigure .tf -height $geometry(topheight)
 765     .ctop paneconfigure .tf -width $geometry(topwidth)
 766
 767     # now build up the bottom
 768     panedwindow .pwbottom -orient horizontal
 769
 770     # lower left, a text box over search bar, scroll bar to the right
 771     # if we know window height, then that will set the lower text height, otherwise
 772     # we set lower text height which will drive window height
 773     if {[info exists geometry(main)]} {
 774         frame .bleft -width $geometry(botwidth)
 775     } else {
 776         frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
 777     }
 778     frame .bleft.top
 779     frame .bleft.mid
 780
 781     button .bleft.top.search -text "Search" -command dosearch \
 782         -font $uifont
 783     pack .bleft.top.search -side left -padx 5
 784     set sstring .bleft.top.sstring
 785     entry $sstring -width 20 -font $textfont -textvariable searchstring
 786     lappend entries $sstring
 787     trace add variable searchstring write incrsearch
 788     pack $sstring -side left -expand 1 -fill x
 789     radiobutton .bleft.mid.diff -text "Diff" \
 790         -command changediffdisp -variable diffelide -value {0 0}
 791     radiobutton .bleft.mid.old -text "Old version" \
 792         -command changediffdisp -variable diffelide -value {0 1}
 793     radiobutton .bleft.mid.new -text "New version" \
 794         -command changediffdisp -variable diffelide -value {1 0}
 795     label .bleft.mid.labeldiffcontext -text "      Lines of context: " \
 796         -font $uifont
 797     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
 798     spinbox .bleft.mid.diffcontext -width 5 -font $textfont \
 799         -from 1 -increment 1 -to 10000000 \
 800         -validate all -validatecommand "diffcontextvalidate %P" \
 801         -textvariable diffcontextstring
 802     .bleft.mid.diffcontext set $diffcontext
 803     trace add variable diffcontextstring write diffcontextchange
 804     lappend entries .bleft.mid.diffcontext
 805     pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
 806     set ctext .bleft.ctext
 807     text $ctext -background $bgcolor -foreground $fgcolor \
 808         -tabs "[expr {$tabstop * $charspc}]" \
 809         -state disabled -font $textfont \
 810         -yscrollcommand scrolltext -wrap none
 811     scrollbar .bleft.sb -command "$ctext yview"
 812     pack .bleft.top -side top -fill x
 813     pack .bleft.mid -side top -fill x
 814     pack .bleft.sb -side right -fill y
 815     pack $ctext -side left -fill both -expand 1
 816     lappend bglist $ctext
 817     lappend fglist $ctext
 818
 819     $ctext tag conf comment -wrap $wrapcomment
 820     $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
 821     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
 822     $ctext tag conf d0 -fore [lindex $diffcolors 0]
 823     $ctext tag conf d1 -fore [lindex $diffcolors 1]
 824     $ctext tag conf m0 -fore red
 825     $ctext tag conf m1 -fore blue
 826     $ctext tag conf m2 -fore green
 827     $ctext tag conf m3 -fore purple
 828     $ctext tag conf m4 -fore brown
 829     $ctext tag conf m5 -fore "#009090"
 830     $ctext tag conf m6 -fore magenta
 831     $ctext tag conf m7 -fore "#808000"
 832     $ctext tag conf m8 -fore "#009000"
 833     $ctext tag conf m9 -fore "#ff0080"
 834     $ctext tag conf m10 -fore cyan
 835     $ctext tag conf m11 -fore "#b07070"
 836     $ctext tag conf m12 -fore "#70b0f0"
 837     $ctext tag conf m13 -fore "#70f0b0"
 838     $ctext tag conf m14 -fore "#f0b070"
 839     $ctext tag conf m15 -fore "#ff70b0"
 840     $ctext tag conf mmax -fore darkgrey
 841     set mergemax 16
 842     $ctext tag conf mresult -font [concat $textfont bold]
 843     $ctext tag conf msep -font [concat $textfont bold]
 844     $ctext tag conf found -back yellow
 845
 846     .pwbottom add .bleft
 847     .pwbottom paneconfigure .bleft -width $geometry(botwidth)
 848
 849     # lower right
 850     frame .bright
 851     frame .bright.mode
 852     radiobutton .bright.mode.patch -text "Patch" \
 853         -command reselectline -variable cmitmode -value "patch"
 854     .bright.mode.patch configure -font $uifont
 855     radiobutton .bright.mode.tree -text "Tree" \
 856         -command reselectline -variable cmitmode -value "tree"
 857     .bright.mode.tree configure -font $uifont
 858     grid .bright.mode.patch .bright.mode.tree -sticky ew
 859     pack .bright.mode -side top -fill x
 860     set cflist .bright.cfiles
 861     set indent [font measure $mainfont "nn"]
 862     text $cflist \
 863         -selectbackground $selectbgcolor \
 864         -background $bgcolor -foreground $fgcolor \
 865         -font $mainfont \
 866         -tabs [list $indent [expr {2 * $indent}]] \
 867         -yscrollcommand ".bright.sb set" \
 868         -cursor [. cget -cursor] \
 869         -spacing1 1 -spacing3 1
 870     lappend bglist $cflist
 871     lappend fglist $cflist
 872     scrollbar .bright.sb -command "$cflist yview"
 873     pack .bright.sb -side right -fill y
 874     pack $cflist -side left -fill both -expand 1
 875     $cflist tag configure highlight \
 876         -background [$cflist cget -selectbackground]
 877     $cflist tag configure bold -font [concat $mainfont bold]
 878
 879     .pwbottom add .bright
 880     .ctop add .pwbottom
 881
 882     # restore window position if known
 883     if {[info exists geometry(main)]} {
 884         wm geometry . "$geometry(main)"
 885     }
 886
 887     if {[tk windowingsystem] eq {aqua}} {
 888         set M1B M1
 889     } else {
 890         set M1B Control
 891     }
 892
 893     bind .pwbottom <Configure> {resizecdetpanes %W %w}
 894     pack .ctop -fill both -expand 1
 895     bindall <1> {selcanvline %W %x %y}
 896     #bindall <B1-Motion> {selcanvline %W %x %y}
 897     if {[tk windowingsystem] == "win32"} {
 898         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
 899         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
 900     } else {
 901         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 902         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 903     }
 904     bindall <2> "canvscan mark %W %x %y"
 905     bindall <B2-Motion> "canvscan dragto %W %x %y"
 906     bindkey <Home> selfirstline
 907     bindkey <End> sellastline
 908     bind . <Key-Up> "selnextline -1"
 909     bind . <Key-Down> "selnextline 1"
 910     bind . <Shift-Key-Up> "next_highlight -1"
 911     bind . <Shift-Key-Down> "next_highlight 1"
 912     bindkey <Key-Right> "goforw"
 913     bindkey <Key-Left> "goback"
 914     bind . <Key-Prior> "selnextpage -1"
 915     bind . <Key-Next> "selnextpage 1"
 916     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
 917     bind . <$M1B-End> "allcanvs yview moveto 1.0"
 918     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
 919     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
 920     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
 921     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
 922     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 923     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 924     bindkey <Key-space> "$ctext yview scroll 1 pages"
 925     bindkey p "selnextline -1"
 926     bindkey n "selnextline 1"
 927     bindkey z "goback"
 928     bindkey x "goforw"
 929     bindkey i "selnextline -1"
 930     bindkey k "selnextline 1"
 931     bindkey j "goback"
 932     bindkey l "goforw"
 933     bindkey b "$ctext yview scroll -1 pages"
 934     bindkey d "$ctext yview scroll 18 units"
 935     bindkey u "$ctext yview scroll -18 units"
 936     bindkey / {findnext 1}
 937     bindkey <Key-Return> {findnext 0}
 938     bindkey ? findprev
 939     bindkey f nextfile
 940     bindkey <F5> updatecommits
 941     bind . <$M1B-q> doquit
 942     bind . <$M1B-f> dofind
 943     bind . <$M1B-g> {findnext 0}
 944     bind . <$M1B-r> dosearchback
 945     bind . <$M1B-s> dosearch
 946     bind . <$M1B-equal> {incrfont 1}
 947     bind . <$M1B-KP_Add> {incrfont 1}
 948     bind . <$M1B-minus> {incrfont -1}
 949     bind . <$M1B-KP_Subtract> {incrfont -1}
 950     wm protocol . WM_DELETE_WINDOW doquit
 951     bind . <Button-1> "click %W"
 952     bind $fstring <Key-Return> dofind
 953     bind $sha1entry <Key-Return> gotocommit
 954     bind $sha1entry <<PasteSelection>> clearsha1
 955     bind $cflist <1> {sel_flist %W %x %y; break}
 956     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
 957     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
 958     bind $cflist <Button-3> {pop_flist_menu %W %X %Y %x %y}
 959
 960     set maincursor [. cget -cursor]
 961     set textcursor [$ctext cget -cursor]
 962     set curtextcursor $textcursor
 963
 964     set rowctxmenu .rowctxmenu
 965     menu $rowctxmenu -tearoff 0
 966     $rowctxmenu add command -label "Diff this -> selected" \
 967         -command {diffvssel 0}
 968     $rowctxmenu add command -label "Diff selected -> this" \
 969         -command {diffvssel 1}
 970     $rowctxmenu add command -label "Make patch" -command mkpatch
 971     $rowctxmenu add command -label "Create tag" -command mktag
 972     $rowctxmenu add command -label "Write commit to file" -command writecommit
 973     $rowctxmenu add command -label "Create new branch" -command mkbranch
 974     $rowctxmenu add command -label "Cherry-pick this commit" \
 975         -command cherrypick
 976     $rowctxmenu add command -label "Reset HEAD branch to here" \
 977         -command resethead
 978
 979     set fakerowmenu .fakerowmenu
 980     menu $fakerowmenu -tearoff 0
 981     $fakerowmenu add command -label "Diff this -> selected" \
 982         -command {diffvssel 0}
 983     $fakerowmenu add command -label "Diff selected -> this" \
 984         -command {diffvssel 1}
 985     $fakerowmenu add command -label "Make patch" -command mkpatch
 986 #    $fakerowmenu add command -label "Commit" -command {mkcommit 0}
 987 #    $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
 988 #    $fakerowmenu add command -label "Revert local changes" -command revertlocal
 989
 990     set headctxmenu .headctxmenu
 991     menu $headctxmenu -tearoff 0
 992     $headctxmenu add command -label "Check out this branch" \
 993         -command cobranch
 994     $headctxmenu add command -label "Remove this branch" \
 995         -command rmbranch
 996
 997     global flist_menu
 998     set flist_menu .flistctxmenu
 999     menu $flist_menu -tearoff 0
1000     $flist_menu add command -label "Highlight this too" \
1001         -command {flist_hl 0}
1002     $flist_menu add command -label "Highlight this only" \
1003         -command {flist_hl 1}
1004 }
1005
1006 # Windows sends all mouse wheel events to the current focused window, not
1007 # the one where the mouse hovers, so bind those events here and redirect
1008 # to the correct window
1009 proc windows_mousewheel_redirector {W X Y D} {
1010     global canv canv2 canv3
1011     set w [winfo containing -displayof $W $X $Y]
1012     if {$w ne ""} {
1013         set u [expr {$D < 0 ? 5 : -5}]
1014         if {$w == $canv || $w == $canv2 || $w == $canv3} {
1015             allcanvs yview scroll $u units
1016         } else {
1017             catch {
1018                 $w yview scroll $u units
1019             }
1020         }
1021     }
1022 }
1023
1024 # mouse-2 makes all windows scan vertically, but only the one
1025 # the cursor is in scans horizontally
1026 proc canvscan {op w x y} {
1027     global canv canv2 canv3
1028     foreach c [list $canv $canv2 $canv3] {
1029         if {$c == $w} {
1030             $c scan $op $x $y
1031         } else {
1032             $c scan $op 0 $y
1033         }
1034     }
1035 }
1036
1037 proc scrollcanv {cscroll f0 f1} {
1038     $cscroll set $f0 $f1
1039     drawfrac $f0 $f1
1040     flushhighlights
1041 }
1042
1043 # when we make a key binding for the toplevel, make sure
1044 # it doesn't get triggered when that key is pressed in the
1045 # find string entry widget.
1046 proc bindkey {ev script} {
1047     global entries
1048     bind . $ev $script
1049     set escript [bind Entry $ev]
1050     if {$escript == {}} {
1051         set escript [bind Entry <Key>]
1052     }
1053     foreach e $entries {
1054         bind $e $ev "$escript; break"
1055     }
1056 }
1057
1058 # set the focus back to the toplevel for any click outside
1059 # the entry widgets
1060 proc click {w} {
1061     global ctext entries
1062     foreach e [concat $entries $ctext] {
1063         if {$w == $e} return
1064     }
1065     focus .
1066 }
1067
1068 proc savestuff {w} {
1069     global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
1070     global stuffsaved findmergefiles maxgraphpct
1071     global maxwidth showneartags showlocalchanges
1072     global viewname viewfiles viewargs viewperm nextviewnum
1073     global cmitmode wrapcomment datetimeformat
1074     global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
1075
1076     if {$stuffsaved} return
1077     if {![winfo viewable .]} return
1078     catch {
1079         set f [open "~/.gitk-new" w]
1080         puts $f [list set mainfont $mainfont]
1081         puts $f [list set textfont $textfont]
1082         puts $f [list set uifont $uifont]
1083         puts $f [list set tabstop $tabstop]
1084         puts $f [list set findmergefiles $findmergefiles]
1085         puts $f [list set maxgraphpct $maxgraphpct]
1086         puts $f [list set maxwidth $maxwidth]
1087         puts $f [list set cmitmode $cmitmode]
1088         puts $f [list set wrapcomment $wrapcomment]
1089         puts $f [list set showneartags $showneartags]
1090         puts $f [list set showlocalchanges $showlocalchanges]
1091         puts $f [list set datetimeformat $datetimeformat]
1092         puts $f [list set bgcolor $bgcolor]
1093         puts $f [list set fgcolor $fgcolor]
1094         puts $f [list set colors $colors]
1095         puts $f [list set diffcolors $diffcolors]
1096         puts $f [list set diffcontext $diffcontext]
1097         puts $f [list set selectbgcolor $selectbgcolor]
1098
1099         puts $f "set geometry(main) [wm geometry .]"
1100         puts $f "set geometry(topwidth) [winfo width .tf]"
1101         puts $f "set geometry(topheight) [winfo height .tf]"
1102         puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
1103         puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
1104         puts $f "set geometry(botwidth) [winfo width .bleft]"
1105         puts $f "set geometry(botheight) [winfo height .bleft]"
1106
1107         puts -nonewline $f "set permviews {"
1108         for {set v 0} {$v < $nextviewnum} {incr v} {
1109             if {$viewperm($v)} {
1110                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
1111             }
1112         }
1113         puts $f "}"
1114         close $f
1115         file rename -force "~/.gitk-new" "~/.gitk"
1116     }
1117     set stuffsaved 1
1118 }
1119
1120 proc resizeclistpanes {win w} {
1121     global oldwidth
1122     if {[info exists oldwidth($win)]} {
1123         set s0 [$win sash coord 0]
1124         set s1 [$win sash coord 1]
1125         if {$w < 60} {
1126             set sash0 [expr {int($w/2 - 2)}]
1127             set sash1 [expr {int($w*5/6 - 2)}]
1128         } else {
1129             set factor [expr {1.0 * $w / $oldwidth($win)}]
1130             set sash0 [expr {int($factor * [lindex $s0 0])}]
1131             set sash1 [expr {int($factor * [lindex $s1 0])}]
1132             if {$sash0 < 30} {
1133                 set sash0 30
1134             }
1135             if {$sash1 < $sash0 + 20} {
1136                 set sash1 [expr {$sash0 + 20}]
1137             }
1138             if {$sash1 > $w - 10} {
1139                 set sash1 [expr {$w - 10}]
1140                 if {$sash0 > $sash1 - 20} {
1141                     set sash0 [expr {$sash1 - 20}]
1142                 }
1143             }
1144         }
1145         $win sash place 0 $sash0 [lindex $s0 1]
1146         $win sash place 1 $sash1 [lindex $s1 1]
1147     }
1148     set oldwidth($win) $w
1149 }
1150
1151 proc resizecdetpanes {win w} {
1152     global oldwidth
1153     if {[info exists oldwidth($win)]} {
1154         set s0 [$win sash coord 0]
1155         if {$w < 60} {
1156             set sash0 [expr {int($w*3/4 - 2)}]
1157         } else {
1158             set factor [expr {1.0 * $w / $oldwidth($win)}]
1159             set sash0 [expr {int($factor * [lindex $s0 0])}]
1160             if {$sash0 < 45} {
1161                 set sash0 45
1162             }
1163             if {$sash0 > $w - 15} {
1164                 set sash0 [expr {$w - 15}]
1165             }
1166         }
1167         $win sash place 0 $sash0 [lindex $s0 1]
1168     }
1169     set oldwidth($win) $w
1170 }
1171
1172 proc allcanvs args {
1173     global canv canv2 canv3
1174     eval $canv $args
1175     eval $canv2 $args
1176     eval $canv3 $args
1177 }
1178
1179 proc bindall {event action} {
1180     global canv canv2 canv3
1181     bind $canv $event $action
1182     bind $canv2 $event $action
1183     bind $canv3 $event $action
1184 }
1185
1186 proc about {} {
1187     global uifont
1188     set w .about
1189     if {[winfo exists $w]} {
1190         raise $w
1191         return
1192     }
1193     toplevel $w
1194     wm title $w "About gitk"
1195     message $w.m -text {
1196 Gitk - a commit viewer for git
1197
1198 Copyright © 2005-2006 Paul Mackerras
1199
1200 Use and redistribute under the terms of the GNU General Public License} \
1201             -justify center -aspect 400 -border 2 -bg white -relief groove
1202     pack $w.m -side top -fill x -padx 2 -pady 2
1203     $w.m configure -font $uifont
1204     button $w.ok -text Close -command "destroy $w" -default active
1205     pack $w.ok -side bottom
1206     $w.ok configure -font $uifont
1207     bind $w <Visibility> "focus $w.ok"
1208     bind $w <Key-Escape> "destroy $w"
1209     bind $w <Key-Return> "destroy $w"
1210 }
1211
1212 proc keys {} {
1213     global uifont
1214     set w .keys
1215     if {[winfo exists $w]} {
1216         raise $w
1217         return
1218     }
1219     if {[tk windowingsystem] eq {aqua}} {
1220         set M1T Cmd
1221     } else {
1222         set M1T Ctrl
1223     }
1224     toplevel $w
1225     wm title $w "Gitk key bindings"
1226     message $w.m -text "
1227 Gitk key bindings:
1228
1229 <$M1T-Q>                Quit
1230 <Home>          Move to first commit
1231 <End>           Move to last commit
1232 <Up>, p, i      Move up one commit
1233 <Down>, n, k    Move down one commit
1234 <Left>, z, j    Go back in history list
1235 <Right>, x, l   Go forward in history list
1236 <PageUp>        Move up one page in commit list
1237 <PageDown>      Move down one page in commit list
1238 <$M1T-Home>     Scroll to top of commit list
1239 <$M1T-End>      Scroll to bottom of commit list
1240 <$M1T-Up>       Scroll commit list up one line
1241 <$M1T-Down>     Scroll commit list down one line
1242 <$M1T-PageUp>   Scroll commit list up one page
1243 <$M1T-PageDown> Scroll commit list down one page
1244 <Shift-Up>      Move to previous highlighted line
1245 <Shift-Down>    Move to next highlighted line
1246 <Delete>, b     Scroll diff view up one page
1247 <Backspace>     Scroll diff view up one page
1248 <Space>         Scroll diff view down one page
1249 u               Scroll diff view up 18 lines
1250 d               Scroll diff view down 18 lines
1251 <$M1T-F>                Find
1252 <$M1T-G>                Move to next find hit
1253 <Return>        Move to next find hit
1254 /               Move to next find hit, or redo find
1255 ?               Move to previous find hit
1256 f               Scroll diff view to next file
1257 <$M1T-S>                Search for next hit in diff view
1258 <$M1T-R>                Search for previous hit in diff view
1259 <$M1T-KP+>      Increase font size
1260 <$M1T-plus>     Increase font size
1261 <$M1T-KP->      Decrease font size
1262 <$M1T-minus>    Decrease font size
1263 <F5>            Update
1264 " \
1265             -justify left -bg white -border 2 -relief groove
1266     pack $w.m -side top -fill both -padx 2 -pady 2
1267     $w.m configure -font $uifont
1268     button $w.ok -text Close -command "destroy $w" -default active
1269     pack $w.ok -side bottom
1270     $w.ok configure -font $uifont
1271     bind $w <Visibility> "focus $w.ok"
1272     bind $w <Key-Escape> "destroy $w"
1273     bind $w <Key-Return> "destroy $w"
1274 }
1275
1276 # Procedures for manipulating the file list window at the
1277 # bottom right of the overall window.
1278
1279 proc treeview {w l openlevs} {
1280     global treecontents treediropen treeheight treeparent treeindex
1281
1282     set ix 0
1283     set treeindex() 0
1284     set lev 0
1285     set prefix {}
1286     set prefixend -1
1287     set prefendstack {}
1288     set htstack {}
1289     set ht 0
1290     set treecontents() {}
1291     $w conf -state normal
1292     foreach f $l {
1293         while {[string range $f 0 $prefixend] ne $prefix} {
1294             if {$lev <= $openlevs} {
1295                 $w mark set e:$treeindex($prefix) "end -1c"
1296                 $w mark gravity e:$treeindex($prefix) left
1297             }
1298             set treeheight($prefix) $ht
1299             incr ht [lindex $htstack end]
1300             set htstack [lreplace $htstack end end]
1301             set prefixend [lindex $prefendstack end]
1302             set prefendstack [lreplace $prefendstack end end]
1303             set prefix [string range $prefix 0 $prefixend]
1304             incr lev -1
1305         }
1306         set tail [string range $f [expr {$prefixend+1}] end]
1307         while {[set slash [string first "/" $tail]] >= 0} {
1308             lappend htstack $ht
1309             set ht 0
1310             lappend prefendstack $prefixend
1311             incr prefixend [expr {$slash + 1}]
1312             set d [string range $tail 0 $slash]
1313             lappend treecontents($prefix) $d
1314             set oldprefix $prefix
1315             append prefix $d
1316             set treecontents($prefix) {}
1317             set treeindex($prefix) [incr ix]
1318             set treeparent($prefix) $oldprefix
1319             set tail [string range $tail [expr {$slash+1}] end]
1320             if {$lev <= $openlevs} {
1321                 set ht 1
1322                 set treediropen($prefix) [expr {$lev < $openlevs}]
1323                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1324                 $w mark set d:$ix "end -1c"
1325                 $w mark gravity d:$ix left
1326                 set str "\n"
1327                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1328                 $w insert end $str
1329                 $w image create end -align center -image $bm -padx 1 \
1330                     -name a:$ix
1331                 $w insert end $d [highlight_tag $prefix]
1332                 $w mark set s:$ix "end -1c"
1333                 $w mark gravity s:$ix left
1334             }
1335             incr lev
1336         }
1337         if {$tail ne {}} {
1338             if {$lev <= $openlevs} {
1339                 incr ht
1340                 set str "\n"
1341                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1342                 $w insert end $str
1343                 $w insert end $tail [highlight_tag $f]
1344             }
1345             lappend treecontents($prefix) $tail
1346         }
1347     }
1348     while {$htstack ne {}} {
1349         set treeheight($prefix) $ht
1350         incr ht [lindex $htstack end]
1351         set htstack [lreplace $htstack end end]
1352         set prefixend [lindex $prefendstack end]
1353         set prefendstack [lreplace $prefendstack end end]
1354         set prefix [string range $prefix 0 $prefixend]
1355     }
1356     $w conf -state disabled
1357 }
1358
1359 proc linetoelt {l} {
1360     global treeheight treecontents
1361
1362     set y 2
1363     set prefix {}
1364     while {1} {
1365         foreach e $treecontents($prefix) {
1366             if {$y == $l} {
1367                 return "$prefix$e"
1368             }
1369             set n 1
1370             if {[string index $e end] eq "/"} {
1371                 set n $treeheight($prefix$e)
1372                 if {$y + $n > $l} {
1373                     append prefix $e
1374                     incr y
1375                     break
1376                 }
1377             }
1378             incr y $n
1379         }
1380     }
1381 }
1382
1383 proc highlight_tree {y prefix} {
1384     global treeheight treecontents cflist
1385
1386     foreach e $treecontents($prefix) {
1387         set path $prefix$e
1388         if {[highlight_tag $path] ne {}} {
1389             $cflist tag add bold $y.0 "$y.0 lineend"
1390         }
1391         incr y
1392         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1393             set y [highlight_tree $y $path]
1394         }
1395     }
1396     return $y
1397 }
1398
1399 proc treeclosedir {w dir} {
1400     global treediropen treeheight treeparent treeindex
1401
1402     set ix $treeindex($dir)
1403     $w conf -state normal
1404     $w delete s:$ix e:$ix
1405     set treediropen($dir) 0
1406     $w image configure a:$ix -image tri-rt
1407     $w conf -state disabled
1408     set n [expr {1 - $treeheight($dir)}]
1409     while {$dir ne {}} {
1410         incr treeheight($dir) $n
1411         set dir $treeparent($dir)
1412     }
1413 }
1414
1415 proc treeopendir {w dir} {
1416     global treediropen treeheight treeparent treecontents treeindex
1417
1418     set ix $treeindex($dir)
1419     $w conf -state normal
1420     $w image configure a:$ix -image tri-dn
1421     $w mark set e:$ix s:$ix
1422     $w mark gravity e:$ix right
1423     set lev 0
1424     set str "\n"
1425     set n [llength $treecontents($dir)]
1426     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1427         incr lev
1428         append str "\t"
1429         incr treeheight($x) $n
1430     }
1431     foreach e $treecontents($dir) {
1432         set de $dir$e
1433         if {[string index $e end] eq "/"} {
1434             set iy $treeindex($de)
1435             $w mark set d:$iy e:$ix
1436             $w mark gravity d:$iy left
1437             $w insert e:$ix $str
1438             set treediropen($de) 0
1439             $w image create e:$ix -align center -image tri-rt -padx 1 \
1440                 -name a:$iy
1441             $w insert e:$ix $e [highlight_tag $de]
1442             $w mark set s:$iy e:$ix
1443             $w mark gravity s:$iy left
1444             set treeheight($de) 1
1445         } else {
1446             $w insert e:$ix $str
1447             $w insert e:$ix $e [highlight_tag $de]
1448         }
1449     }
1450     $w mark gravity e:$ix left
1451     $w conf -state disabled
1452     set treediropen($dir) 1
1453     set top [lindex [split [$w index @0,0] .] 0]
1454     set ht [$w cget -height]
1455     set l [lindex [split [$w index s:$ix] .] 0]
1456     if {$l < $top} {
1457         $w yview $l.0
1458     } elseif {$l + $n + 1 > $top + $ht} {
1459         set top [expr {$l + $n + 2 - $ht}]
1460         if {$l < $top} {
1461             set top $l
1462         }
1463         $w yview $top.0
1464     }
1465 }
1466
1467 proc treeclick {w x y} {
1468     global treediropen cmitmode ctext cflist cflist_top
1469
1470     if {$cmitmode ne "tree"} return
1471     if {![info exists cflist_top]} return
1472     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1473     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1474     $cflist tag add highlight $l.0 "$l.0 lineend"
1475     set cflist_top $l
1476     if {$l == 1} {
1477         $ctext yview 1.0
1478         return
1479     }
1480     set e [linetoelt $l]
1481     if {[string index $e end] ne "/"} {
1482         showfile $e
1483     } elseif {$treediropen($e)} {
1484         treeclosedir $w $e
1485     } else {
1486         treeopendir $w $e
1487     }
1488 }
1489
1490 proc setfilelist {id} {
1491     global treefilelist cflist
1492
1493     treeview $cflist $treefilelist($id) 0
1494 }
1495
1496 image create bitmap tri-rt -background black -foreground blue -data {
1497     #define tri-rt_width 13
1498     #define tri-rt_height 13
1499     static unsigned char tri-rt_bits[] = {
1500        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1501        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1502        0x00, 0x00};
1503 } -maskdata {
1504     #define tri-rt-mask_width 13
1505     #define tri-rt-mask_height 13
1506     static unsigned char tri-rt-mask_bits[] = {
1507        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1508        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1509        0x08, 0x00};
1510 }
1511 image create bitmap tri-dn -background black -foreground blue -data {
1512     #define tri-dn_width 13
1513     #define tri-dn_height 13
1514     static unsigned char tri-dn_bits[] = {
1515        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1516        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1517        0x00, 0x00};
1518 } -maskdata {
1519     #define tri-dn-mask_width 13
1520     #define tri-dn-mask_height 13
1521     static unsigned char tri-dn-mask_bits[] = {
1522        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1523        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1524        0x00, 0x00};
1525 }
1526
1527 image create bitmap reficon-T -background black -foreground yellow -data {
1528     #define tagicon_width 13
1529     #define tagicon_height 9
1530     static unsigned char tagicon_bits[] = {
1531        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
1532        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
1533 } -maskdata {
1534     #define tagicon-mask_width 13
1535     #define tagicon-mask_height 9
1536     static unsigned char tagicon-mask_bits[] = {
1537        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
1538        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
1539 }
1540 set rectdata {
1541     #define headicon_width 13
1542     #define headicon_height 9
1543     static unsigned char headicon_bits[] = {
1544        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
1545        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
1546 }
1547 set rectmask {
1548     #define headicon-mask_width 13
1549     #define headicon-mask_height 9
1550     static unsigned char headicon-mask_bits[] = {
1551        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
1552        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
1553 }
1554 image create bitmap reficon-H -background black -foreground green \
1555     -data $rectdata -maskdata $rectmask
1556 image create bitmap reficon-o -background black -foreground "#ddddff" \
1557     -data $rectdata -maskdata $rectmask
1558
1559 proc init_flist {first} {
1560     global cflist cflist_top selectedline difffilestart
1561
1562     $cflist conf -state normal
1563     $cflist delete 0.0 end
1564     if {$first ne {}} {
1565         $cflist insert end $first
1566         set cflist_top 1
1567         $cflist tag add highlight 1.0 "1.0 lineend"
1568     } else {
1569         catch {unset cflist_top}
1570     }
1571     $cflist conf -state disabled
1572     set difffilestart {}
1573 }
1574
1575 proc highlight_tag {f} {
1576     global highlight_paths
1577
1578     foreach p $highlight_paths {
1579         if {[string match $p $f]} {
1580             return "bold"
1581         }
1582     }
1583     return {}
1584 }
1585
1586 proc highlight_filelist {} {
1587     global cmitmode cflist
1588
1589     $cflist conf -state normal
1590     if {$cmitmode ne "tree"} {
1591         set end [lindex [split [$cflist index end] .] 0]
1592         for {set l 2} {$l < $end} {incr l} {
1593             set line [$cflist get $l.0 "$l.0 lineend"]
1594             if {[highlight_tag $line] ne {}} {
1595                 $cflist tag add bold $l.0 "$l.0 lineend"
1596             }
1597         }
1598     } else {
1599         highlight_tree 2 {}
1600     }
1601     $cflist conf -state disabled
1602 }
1603
1604 proc unhighlight_filelist {} {
1605     global cflist
1606
1607     $cflist conf -state normal
1608     $cflist tag remove bold 1.0 end
1609     $cflist conf -state disabled
1610 }
1611
1612 proc add_flist {fl} {
1613     global cflist
1614
1615     $cflist conf -state normal
1616     foreach f $fl {
1617         $cflist insert end "\n"
1618         $cflist insert end $f [highlight_tag $f]
1619     }
1620     $cflist conf -state disabled
1621 }
1622
1623 proc sel_flist {w x y} {
1624     global ctext difffilestart cflist cflist_top cmitmode
1625
1626     if {$cmitmode eq "tree"} return
1627     if {![info exists cflist_top]} return
1628     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1629     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1630     $cflist tag add highlight $l.0 "$l.0 lineend"
1631     set cflist_top $l
1632     if {$l == 1} {
1633         $ctext yview 1.0
1634     } else {
1635         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1636     }
1637 }
1638
1639 proc pop_flist_menu {w X Y x y} {
1640     global ctext cflist cmitmode flist_menu flist_menu_file
1641     global treediffs diffids
1642
1643     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1644     if {$l <= 1} return
1645     if {$cmitmode eq "tree"} {
1646         set e [linetoelt $l]
1647         if {[string index $e end] eq "/"} return
1648     } else {
1649         set e [lindex $treediffs($diffids) [expr {$l-2}]]
1650     }
1651     set flist_menu_file $e
1652     tk_popup $flist_menu $X $Y
1653 }
1654
1655 proc flist_hl {only} {
1656     global flist_menu_file highlight_files
1657
1658     set x [shellquote $flist_menu_file]
1659     if {$only || $highlight_files eq {}} {
1660         set highlight_files $x
1661     } else {
1662         append highlight_files " " $x
1663     }
1664 }
1665
1666 # Functions for adding and removing shell-type quoting
1667
1668 proc shellquote {str} {
1669     if {![string match "*\['\"\\ \t]*" $str]} {
1670         return $str
1671     }
1672     if {![string match "*\['\"\\]*" $str]} {
1673         return "\"$str\""
1674     }
1675     if {![string match "*'*" $str]} {
1676         return "'$str'"
1677     }
1678     return "\"[string map {\" \\\" \\ \\\\} $str]\""
1679 }
1680
1681 proc shellarglist {l} {
1682     set str {}
1683     foreach a $l {
1684         if {$str ne {}} {
1685             append str " "
1686         }
1687         append str [shellquote $a]
1688     }
1689     return $str
1690 }
1691
1692 proc shelldequote {str} {
1693     set ret {}
1694     set used -1
1695     while {1} {
1696         incr used
1697         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1698             append ret [string range $str $used end]
1699             set used [string length $str]
1700             break
1701         }
1702         set first [lindex $first 0]
1703         set ch [string index $str $first]
1704         if {$first > $used} {
1705             append ret [string range $str $used [expr {$first - 1}]]
1706             set used $first
1707         }
1708         if {$ch eq " " || $ch eq "\t"} break
1709         incr used
1710         if {$ch eq "'"} {
1711             set first [string first "'" $str $used]
1712             if {$first < 0} {
1713                 error "unmatched single-quote"
1714             }
1715             append ret [string range $str $used [expr {$first - 1}]]
1716             set used $first
1717             continue
1718         }
1719         if {$ch eq "\\"} {
1720             if {$used >= [string length $str]} {
1721                 error "trailing backslash"
1722             }
1723             append ret [string index $str $used]
1724             continue
1725         }
1726         # here ch == "\""
1727         while {1} {
1728             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1729                 error "unmatched double-quote"
1730             }
1731             set first [lindex $first 0]
1732             set ch [string index $str $first]
1733             if {$first > $used} {
1734                 append ret [string range $str $used [expr {$first - 1}]]
1735                 set used $first
1736             }
1737             if {$ch eq "\""} break
1738             incr used
1739             append ret [string index $str $used]
1740             incr used
1741         }
1742     }
1743     return [list $used $ret]
1744 }
1745
1746 proc shellsplit {str} {
1747     set l {}
1748     while {1} {
1749         set str [string trimleft $str]
1750         if {$str eq {}} break
1751         set dq [shelldequote $str]
1752         set n [lindex $dq 0]
1753         set word [lindex $dq 1]
1754         set str [string range $str $n end]
1755         lappend l $word
1756     }
1757     return $l
1758 }
1759
1760 # Code to implement multiple views
1761
1762 proc newview {ishighlight} {
1763     global nextviewnum newviewname newviewperm uifont newishighlight
1764     global newviewargs revtreeargs
1765
1766     set newishighlight $ishighlight
1767     set top .gitkview
1768     if {[winfo exists $top]} {
1769         raise $top
1770         return
1771     }
1772     set newviewname($nextviewnum) "View $nextviewnum"
1773     set newviewperm($nextviewnum) 0
1774     set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1775     vieweditor $top $nextviewnum "Gitk view definition"
1776 }
1777
1778 proc editview {} {
1779     global curview
1780     global viewname viewperm newviewname newviewperm
1781     global viewargs newviewargs
1782
1783     set top .gitkvedit-$curview
1784     if {[winfo exists $top]} {
1785         raise $top
1786         return
1787     }
1788     set newviewname($curview) $viewname($curview)
1789     set newviewperm($curview) $viewperm($curview)
1790     set newviewargs($curview) [shellarglist $viewargs($curview)]
1791     vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1792 }
1793
1794 proc vieweditor {top n title} {
1795     global newviewname newviewperm viewfiles
1796     global uifont
1797
1798     toplevel $top
1799     wm title $top $title
1800     label $top.nl -text "Name" -font $uifont
1801     entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
1802     grid $top.nl $top.name -sticky w -pady 5
1803     checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
1804         -font $uifont
1805     grid $top.perm - -pady 5 -sticky w
1806     message $top.al -aspect 1000 -font $uifont \
1807         -text "Commits to include (arguments to git rev-list):"
1808     grid $top.al - -sticky w -pady 5
1809     entry $top.args -width 50 -textvariable newviewargs($n) \
1810         -background white -font $uifont
1811     grid $top.args - -sticky ew -padx 5
1812     message $top.l -aspect 1000 -font $uifont \
1813         -text "Enter files and directories to include, one per line:"
1814     grid $top.l - -sticky w
1815     text $top.t -width 40 -height 10 -background white -font $uifont
1816     if {[info exists viewfiles($n)]} {
1817         foreach f $viewfiles($n) {
1818             $top.t insert end $f
1819             $top.t insert end "\n"
1820         }
1821         $top.t delete {end - 1c} end
1822         $top.t mark set insert 0.0
1823     }
1824     grid $top.t - -sticky ew -padx 5
1825     frame $top.buts
1826     button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
1827         -font $uifont
1828     button $top.buts.can -text "Cancel" -command [list destroy $top] \
1829         -font $uifont
1830     grid $top.buts.ok $top.buts.can
1831     grid columnconfigure $top.buts 0 -weight 1 -uniform a
1832     grid columnconfigure $top.buts 1 -weight 1 -uniform a
1833     grid $top.buts - -pady 10 -sticky ew
1834     focus $top.t
1835 }
1836
1837 proc doviewmenu {m first cmd op argv} {
1838     set nmenu [$m index end]
1839     for {set i $first} {$i <= $nmenu} {incr i} {
1840         if {[$m entrycget $i -command] eq $cmd} {
1841             eval $m $op $i $argv
1842             break
1843         }
1844     }
1845 }
1846
1847 proc allviewmenus {n op args} {
1848     global viewhlmenu
1849
1850     doviewmenu .bar.view 5 [list showview $n] $op $args
1851     doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1852 }
1853
1854 proc newviewok {top n} {
1855     global nextviewnum newviewperm newviewname newishighlight
1856     global viewname viewfiles viewperm selectedview curview
1857     global viewargs newviewargs viewhlmenu
1858
1859     if {[catch {
1860         set newargs [shellsplit $newviewargs($n)]
1861     } err]} {
1862         error_popup "Error in commit selection arguments: $err"
1863         wm raise $top
1864         focus $top
1865         return
1866     }
1867     set files {}
1868     foreach f [split [$top.t get 0.0 end] "\n"] {
1869         set ft [string trim $f]
1870         if {$ft ne {}} {
1871             lappend files $ft
1872         }
1873     }
1874     if {![info exists viewfiles($n)]} {
1875         # creating a new view
1876         incr nextviewnum
1877         set viewname($n) $newviewname($n)
1878         set viewperm($n) $newviewperm($n)
1879         set viewfiles($n) $files
1880         set viewargs($n) $newargs
1881         addviewmenu $n
1882         if {!$newishighlight} {
1883             run showview $n
1884         } else {
1885             run addvhighlight $n
1886         }
1887     } else {
1888         # editing an existing view
1889         set viewperm($n) $newviewperm($n)
1890         if {$newviewname($n) ne $viewname($n)} {
1891             set viewname($n) $newviewname($n)
1892             doviewmenu .bar.view 5 [list showview $n] \
1893                 entryconf [list -label $viewname($n)]
1894             doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1895                 entryconf [list -label $viewname($n) -value $viewname($n)]
1896         }
1897         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1898             set viewfiles($n) $files
1899             set viewargs($n) $newargs
1900             if {$curview == $n} {
1901                 run updatecommits
1902             }
1903         }
1904     }
1905     catch {destroy $top}
1906 }
1907
1908 proc delview {} {
1909     global curview viewdata viewperm hlview selectedhlview
1910
1911     if {$curview == 0} return
1912     if {[info exists hlview] && $hlview == $curview} {
1913         set selectedhlview None
1914         unset hlview
1915     }
1916     allviewmenus $curview delete
1917     set viewdata($curview) {}
1918     set viewperm($curview) 0
1919     showview 0
1920 }
1921
1922 proc addviewmenu {n} {
1923     global viewname viewhlmenu
1924
1925     .bar.view add radiobutton -label $viewname($n) \
1926         -command [list showview $n] -variable selectedview -value $n
1927     $viewhlmenu add radiobutton -label $viewname($n) \
1928         -command [list addvhighlight $n] -variable selectedhlview
1929 }
1930
1931 proc flatten {var} {
1932     global $var
1933
1934     set ret {}
1935     foreach i [array names $var] {
1936         lappend ret $i [set $var\($i\)]
1937     }
1938     return $ret
1939 }
1940
1941 proc unflatten {var l} {
1942     global $var
1943
1944     catch {unset $var}
1945     foreach {i v} $l {
1946         set $var\($i\) $v
1947     }
1948 }
1949
1950 proc showview {n} {
1951     global curview viewdata viewfiles
1952     global displayorder parentlist rowidlist
1953     global colormap rowtextx commitrow nextcolor canvxmax
1954     global numcommits commitlisted
1955     global selectedline currentid canv canvy0
1956     global treediffs
1957     global pending_select phase
1958     global commitidx rowlaidout rowoptim
1959     global commfd
1960     global selectedview selectfirst
1961     global vparentlist vdisporder vcmitlisted
1962     global hlview selectedhlview commitinterest
1963
1964     if {$n == $curview} return
1965     set selid {}
1966     if {[info exists selectedline]} {
1967         set selid $currentid
1968         set y [yc $selectedline]
1969         set ymax [lindex [$canv cget -scrollregion] 3]
1970         set span [$canv yview]
1971         set ytop [expr {[lindex $span 0] * $ymax}]
1972         set ybot [expr {[lindex $span 1] * $ymax}]
1973         if {$ytop < $y && $y < $ybot} {
1974             set yscreen [expr {$y - $ytop}]
1975         } else {
1976             set yscreen [expr {($ybot - $ytop) / 2}]
1977         }
1978     } elseif {[info exists pending_select]} {
1979         set selid $pending_select
1980         unset pending_select
1981     }
1982     unselectline
1983     normalline
1984     if {$curview >= 0} {
1985         set vparentlist($curview) $parentlist
1986         set vdisporder($curview) $displayorder
1987         set vcmitlisted($curview) $commitlisted
1988         if {$phase ne {}} {
1989             set viewdata($curview) \
1990                 [list $phase $rowidlist $rowlaidout $rowoptim $numcommits]
1991         } elseif {![info exists viewdata($curview)]
1992                   || [lindex $viewdata($curview) 0] ne {}} {
1993             set viewdata($curview) \
1994                 [list {} $rowidlist]
1995         }
1996     }
1997     catch {unset treediffs}
1998     clear_display
1999     if {[info exists hlview] && $hlview == $n} {
2000         unset hlview
2001         set selectedhlview None
2002     }
2003     catch {unset commitinterest}
2004
2005     set curview $n
2006     set selectedview $n
2007     .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
2008     .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
2009
2010     if {![info exists viewdata($n)]} {
2011         if {$selid ne {}} {
2012             set pending_select $selid
2013         }
2014         getcommits
2015         return
2016     }
2017
2018     set v $viewdata($n)
2019     set phase [lindex $v 0]
2020     set displayorder $vdisporder($n)
2021     set parentlist $vparentlist($n)
2022     set commitlisted $vcmitlisted($n)
2023     set rowidlist [lindex $v 1]
2024     if {$phase eq {}} {
2025         set numcommits [llength $displayorder]
2026     } else {
2027         set rowlaidout [lindex $v 2]
2028         set rowoptim [lindex $v 3]
2029         set numcommits [lindex $v 4]
2030     }
2031
2032     catch {unset colormap}
2033     catch {unset rowtextx}
2034     set nextcolor 0
2035     set canvxmax [$canv cget -width]
2036     set curview $n
2037     set row 0
2038     setcanvscroll
2039     set yf 0
2040     set row {}
2041     set selectfirst 0
2042     if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2043         set row $commitrow($n,$selid)
2044         # try to get the selected row in the same position on the screen
2045         set ymax [lindex [$canv cget -scrollregion] 3]
2046         set ytop [expr {[yc $row] - $yscreen}]
2047         if {$ytop < 0} {
2048             set ytop 0
2049         }
2050         set yf [expr {$ytop * 1.0 / $ymax}]
2051     }
2052     allcanvs yview moveto $yf
2053     drawvisible
2054     if {$row ne {}} {
2055         selectline $row 0
2056     } elseif {$selid ne {}} {
2057         set pending_select $selid
2058     } else {
2059         set row [first_real_row]
2060         if {$row < $numcommits} {
2061             selectline $row 0
2062         } else {
2063             set selectfirst 1
2064         }
2065     }
2066     if {$phase ne {}} {
2067         if {$phase eq "getcommits"} {
2068             show_status "Reading commits..."
2069         }
2070         run chewcommits $n
2071     } elseif {$numcommits == 0} {
2072         show_status "No commits selected"
2073     }
2074     run refill_reflist
2075 }
2076
2077 # Stuff relating to the highlighting facility
2078
2079 proc ishighlighted {row} {
2080     global vhighlights fhighlights nhighlights rhighlights
2081
2082     if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2083         return $nhighlights($row)
2084     }
2085     if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2086         return $vhighlights($row)
2087     }
2088     if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2089         return $fhighlights($row)
2090     }
2091     if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2092         return $rhighlights($row)
2093     }
2094     return 0
2095 }
2096
2097 proc bolden {row font} {
2098     global canv linehtag selectedline boldrows
2099
2100     lappend boldrows $row
2101     $canv itemconf $linehtag($row) -font $font
2102     if {[info exists selectedline] && $row == $selectedline} {
2103         $canv delete secsel
2104         set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2105                    -outline {{}} -tags secsel \
2106                    -fill [$canv cget -selectbackground]]
2107         $canv lower $t
2108     }
2109 }
2110
2111 proc bolden_name {row font} {
2112     global canv2 linentag selectedline boldnamerows
2113
2114     lappend boldnamerows $row
2115     $canv2 itemconf $linentag($row) -font $font
2116     if {[info exists selectedline] && $row == $selectedline} {
2117         $canv2 delete secsel
2118         set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2119                    -outline {{}} -tags secsel \
2120                    -fill [$canv2 cget -selectbackground]]
2121         $canv2 lower $t
2122     }
2123 }
2124
2125 proc unbolden {} {
2126     global mainfont boldrows
2127
2128     set stillbold {}
2129     foreach row $boldrows {
2130         if {![ishighlighted $row]} {
2131             bolden $row $mainfont
2132         } else {
2133             lappend stillbold $row
2134         }
2135     }
2136     set boldrows $stillbold
2137 }
2138
2139 proc addvhighlight {n} {
2140     global hlview curview viewdata vhl_done vhighlights commitidx
2141
2142     if {[info exists hlview]} {
2143         delvhighlight
2144     }
2145     set hlview $n
2146     if {$n != $curview && ![info exists viewdata($n)]} {
2147         set viewdata($n) [list getcommits {{}} 0 0 0]
2148         set vparentlist($n) {}
2149         set vdisporder($n) {}
2150         set vcmitlisted($n) {}
2151         start_rev_list $n
2152     }
2153     set vhl_done $commitidx($hlview)
2154     if {$vhl_done > 0} {
2155         drawvisible
2156     }
2157 }
2158
2159 proc delvhighlight {} {
2160     global hlview vhighlights
2161
2162     if {![info exists hlview]} return
2163     unset hlview
2164     catch {unset vhighlights}
2165     unbolden
2166 }
2167
2168 proc vhighlightmore {} {
2169     global hlview vhl_done commitidx vhighlights
2170     global displayorder vdisporder curview mainfont
2171
2172     set font [concat $mainfont bold]
2173     set max $commitidx($hlview)
2174     if {$hlview == $curview} {
2175         set disp $displayorder
2176     } else {
2177         set disp $vdisporder($hlview)
2178     }
2179     set vr [visiblerows]
2180     set r0 [lindex $vr 0]
2181     set r1 [lindex $vr 1]
2182     for {set i $vhl_done} {$i < $max} {incr i} {
2183         set id [lindex $disp $i]
2184         if {[info exists commitrow($curview,$id)]} {
2185             set row $commitrow($curview,$id)
2186             if {$r0 <= $row && $row <= $r1} {
2187                 if {![highlighted $row]} {
2188                     bolden $row $font
2189                 }
2190                 set vhighlights($row) 1
2191             }
2192         }
2193     }
2194     set vhl_done $max
2195 }
2196
2197 proc askvhighlight {row id} {
2198     global hlview vhighlights commitrow iddrawn mainfont
2199
2200     if {[info exists commitrow($hlview,$id)]} {
2201         if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2202             bolden $row [concat $mainfont bold]
2203         }
2204         set vhighlights($row) 1
2205     } else {
2206         set vhighlights($row) 0
2207     }
2208 }
2209
2210 proc hfiles_change {name ix op} {
2211     global highlight_files filehighlight fhighlights fh_serial
2212     global mainfont highlight_paths
2213
2214     if {[info exists filehighlight]} {
2215         # delete previous highlights
2216         catch {close $filehighlight}
2217         unset filehighlight
2218         catch {unset fhighlights}
2219         unbolden
2220         unhighlight_filelist
2221     }
2222     set highlight_paths {}
2223     after cancel do_file_hl $fh_serial
2224     incr fh_serial
2225     if {$highlight_files ne {}} {
2226         after 300 do_file_hl $fh_serial
2227     }
2228 }
2229
2230 proc makepatterns {l} {
2231     set ret {}
2232     foreach e $l {
2233         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2234         if {[string index $ee end] eq "/"} {
2235             lappend ret "$ee*"
2236         } else {
2237             lappend ret $ee
2238             lappend ret "$ee/*"
2239         }
2240     }
2241     return $ret
2242 }
2243
2244 proc do_file_hl {serial} {
2245     global highlight_files filehighlight highlight_paths gdttype fhl_list
2246
2247     if {$gdttype eq "touching paths:"} {
2248         if {[catch {set paths [shellsplit $highlight_files]}]} return
2249         set highlight_paths [makepatterns $paths]
2250         highlight_filelist
2251         set gdtargs [concat -- $paths]
2252     } else {
2253         set gdtargs [list "-S$highlight_files"]
2254     }
2255     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2256     set filehighlight [open $cmd r+]
2257     fconfigure $filehighlight -blocking 0
2258     filerun $filehighlight readfhighlight
2259     set fhl_list {}
2260     drawvisible
2261     flushhighlights
2262 }
2263
2264 proc flushhighlights {} {
2265     global filehighlight fhl_list
2266
2267     if {[info exists filehighlight]} {
2268         lappend fhl_list {}
2269         puts $filehighlight ""
2270         flush $filehighlight
2271     }
2272 }
2273
2274 proc askfilehighlight {row id} {
2275     global filehighlight fhighlights fhl_list
2276
2277     lappend fhl_list $id
2278     set fhighlights($row) -1
2279     puts $filehighlight $id
2280 }
2281
2282 proc readfhighlight {} {
2283     global filehighlight fhighlights commitrow curview mainfont iddrawn
2284     global fhl_list
2285
2286     if {![info exists filehighlight]} {
2287         return 0
2288     }
2289     set nr 0
2290     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2291         set line [string trim $line]
2292         set i [lsearch -exact $fhl_list $line]
2293         if {$i < 0} continue
2294         for {set j 0} {$j < $i} {incr j} {
2295             set id [lindex $fhl_list $j]
2296             if {[info exists commitrow($curview,$id)]} {
2297                 set fhighlights($commitrow($curview,$id)) 0
2298             }
2299         }
2300         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2301         if {$line eq {}} continue
2302         if {![info exists commitrow($curview,$line)]} continue
2303         set row $commitrow($curview,$line)
2304         if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2305             bolden $row [concat $mainfont bold]
2306         }
2307         set fhighlights($row) 1
2308     }
2309     if {[eof $filehighlight]} {
2310         # strange...
2311         puts "oops, git diff-tree died"
2312         catch {close $filehighlight}
2313         unset filehighlight
2314         return 0
2315     }
2316     next_hlcont
2317     return 1
2318 }
2319
2320 proc find_change {name ix op} {
2321     global nhighlights mainfont boldnamerows
2322     global findstring findpattern findtype
2323
2324     # delete previous highlights, if any
2325     foreach row $boldnamerows {
2326         bolden_name $row $mainfont
2327     }
2328     set boldnamerows {}
2329     catch {unset nhighlights}
2330     unbolden
2331     unmarkmatches
2332     if {$findtype ne "Regexp"} {
2333         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2334                    $findstring]
2335         set findpattern "*$e*"
2336     }
2337     drawvisible
2338 }
2339
2340 proc doesmatch {f} {
2341     global findtype findstring findpattern
2342
2343     if {$findtype eq "Regexp"} {
2344         return [regexp $findstring $f]
2345     } elseif {$findtype eq "IgnCase"} {
2346         return [string match -nocase $findpattern $f]
2347     } else {
2348         return [string match $findpattern $f]
2349     }
2350 }
2351
2352 proc askfindhighlight {row id} {
2353     global nhighlights commitinfo iddrawn mainfont
2354     global findloc
2355     global markingmatches
2356
2357     if {![info exists commitinfo($id)]} {
2358         getcommit $id
2359     }
2360     set info $commitinfo($id)
2361     set isbold 0
2362     set fldtypes {Headline Author Date Committer CDate Comments}
2363     foreach f $info ty $fldtypes {
2364         if {($findloc eq "All fields" || $findloc eq $ty) &&
2365             [doesmatch $f]} {
2366             if {$ty eq "Author"} {
2367                 set isbold 2
2368                 break
2369             }
2370             set isbold 1
2371         }
2372     }
2373     if {$isbold && [info exists iddrawn($id)]} {
2374         set f [concat $mainfont bold]
2375         if {![ishighlighted $row]} {
2376             bolden $row $f
2377             if {$isbold > 1} {
2378                 bolden_name $row $f
2379             }
2380         }
2381         if {$markingmatches} {
2382             markrowmatches $row $id
2383         }
2384     }
2385     set nhighlights($row) $isbold
2386 }
2387
2388 proc markrowmatches {row id} {
2389     global canv canv2 linehtag linentag commitinfo findloc
2390
2391     set headline [lindex $commitinfo($id) 0]
2392     set author [lindex $commitinfo($id) 1]
2393     $canv delete match$row
2394     $canv2 delete match$row
2395     if {$findloc eq "All fields" || $findloc eq "Headline"} {
2396         set m [findmatches $headline]
2397         if {$m ne {}} {
2398             markmatches $canv $row $headline $linehtag($row) $m \
2399                 [$canv itemcget $linehtag($row) -font] $row
2400         }
2401     }
2402     if {$findloc eq "All fields" || $findloc eq "Author"} {
2403         set m [findmatches $author]
2404         if {$m ne {}} {
2405             markmatches $canv2 $row $author $linentag($row) $m \
2406                 [$canv2 itemcget $linentag($row) -font] $row
2407         }
2408     }
2409 }
2410
2411 proc vrel_change {name ix op} {
2412     global highlight_related
2413
2414     rhighlight_none
2415     if {$highlight_related ne "None"} {
2416         run drawvisible
2417     }
2418 }
2419
2420 # prepare for testing whether commits are descendents or ancestors of a
2421 proc rhighlight_sel {a} {
2422     global descendent desc_todo ancestor anc_todo
2423     global highlight_related rhighlights
2424
2425     catch {unset descendent}
2426     set desc_todo [list $a]
2427     catch {unset ancestor}
2428     set anc_todo [list $a]
2429     if {$highlight_related ne "None"} {
2430         rhighlight_none
2431         run drawvisible
2432     }
2433 }
2434
2435 proc rhighlight_none {} {
2436     global rhighlights
2437
2438     catch {unset rhighlights}
2439     unbolden
2440 }
2441
2442 proc is_descendent {a} {
2443     global curview children commitrow descendent desc_todo
2444
2445     set v $curview
2446     set la $commitrow($v,$a)
2447     set todo $desc_todo
2448     set leftover {}
2449     set done 0
2450     for {set i 0} {$i < [llength $todo]} {incr i} {
2451         set do [lindex $todo $i]
2452         if {$commitrow($v,$do) < $la} {
2453             lappend leftover $do
2454             continue
2455         }
2456         foreach nk $children($v,$do) {
2457             if {![info exists descendent($nk)]} {
2458                 set descendent($nk) 1
2459                 lappend todo $nk
2460                 if {$nk eq $a} {
2461                     set done 1
2462                 }
2463             }
2464         }
2465         if {$done} {
2466             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2467             return
2468         }
2469     }
2470     set descendent($a) 0
2471     set desc_todo $leftover
2472 }
2473
2474 proc is_ancestor {a} {
2475     global curview parentlist commitrow ancestor anc_todo
2476
2477     set v $curview
2478     set la $commitrow($v,$a)
2479     set todo $anc_todo
2480     set leftover {}
2481     set done 0
2482     for {set i 0} {$i < [llength $todo]} {incr i} {
2483         set do [lindex $todo $i]
2484         if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2485             lappend leftover $do
2486             continue
2487         }
2488         foreach np [lindex $parentlist $commitrow($v,$do)] {
2489             if {![info exists ancestor($np)]} {
2490                 set ancestor($np) 1
2491                 lappend todo $np
2492                 if {$np eq $a} {
2493                     set done 1
2494                 }
2495             }
2496         }
2497         if {$done} {
2498             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2499             return
2500         }
2501     }
2502     set ancestor($a) 0
2503     set anc_todo $leftover
2504 }
2505
2506 proc askrelhighlight {row id} {
2507     global descendent highlight_related iddrawn mainfont rhighlights
2508     global selectedline ancestor
2509
2510     if {![info exists selectedline]} return
2511     set isbold 0
2512     if {$highlight_related eq "Descendent" ||
2513         $highlight_related eq "Not descendent"} {
2514         if {![info exists descendent($id)]} {
2515             is_descendent $id
2516         }
2517         if {$descendent($id) == ($highlight_related eq "Descendent")} {
2518             set isbold 1
2519         }
2520     } elseif {$highlight_related eq "Ancestor" ||
2521               $highlight_related eq "Not ancestor"} {
2522         if {![info exists ancestor($id)]} {
2523             is_ancestor $id
2524         }
2525         if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2526             set isbold 1
2527         }
2528     }
2529     if {[info exists iddrawn($id)]} {
2530         if {$isbold && ![ishighlighted $row]} {
2531             bolden $row [concat $mainfont bold]
2532         }
2533     }
2534     set rhighlights($row) $isbold
2535 }
2536
2537 proc next_hlcont {} {
2538     global fhl_row fhl_dirn displayorder numcommits
2539     global vhighlights fhighlights nhighlights rhighlights
2540     global hlview filehighlight findstring highlight_related
2541
2542     if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2543     set row $fhl_row
2544     while {1} {
2545         if {$row < 0 || $row >= $numcommits} {
2546             bell
2547             set fhl_dirn 0
2548             return
2549         }
2550         set id [lindex $displayorder $row]
2551         if {[info exists hlview]} {
2552             if {![info exists vhighlights($row)]} {
2553                 askvhighlight $row $id
2554             }
2555             if {$vhighlights($row) > 0} break
2556         }
2557         if {$findstring ne {}} {
2558             if {![info exists nhighlights($row)]} {
2559                 askfindhighlight $row $id
2560             }
2561             if {$nhighlights($row) > 0} break
2562         }
2563         if {$highlight_related ne "None"} {
2564             if {![info exists rhighlights($row)]} {
2565                 askrelhighlight $row $id
2566             }
2567             if {$rhighlights($row) > 0} break
2568         }
2569         if {[info exists filehighlight]} {
2570             if {![info exists fhighlights($row)]} {
2571                 # ask for a few more while we're at it...
2572                 set r $row
2573                 for {set n 0} {$n < 100} {incr n} {
2574                     if {![info exists fhighlights($r)]} {
2575                         askfilehighlight $r [lindex $displayorder $r]
2576                     }
2577                     incr r $fhl_dirn
2578                     if {$r < 0 || $r >= $numcommits} break
2579                 }
2580                 flushhighlights
2581             }
2582             if {$fhighlights($row) < 0} {
2583                 set fhl_row $row
2584                 return
2585             }
2586             if {$fhighlights($row) > 0} break
2587         }
2588         incr row $fhl_dirn
2589     }
2590     set fhl_dirn 0
2591     selectline $row 1
2592 }
2593
2594 proc next_highlight {dirn} {
2595     global selectedline fhl_row fhl_dirn
2596     global hlview filehighlight findstring highlight_related
2597
2598     if {![info exists selectedline]} return
2599     if {!([info exists hlview] || $findstring ne {} ||
2600           $highlight_related ne "None" || [info exists filehighlight])} return
2601     set fhl_row [expr {$selectedline + $dirn}]
2602     set fhl_dirn $dirn
2603     next_hlcont
2604 }
2605
2606 proc cancel_next_highlight {} {
2607     global fhl_dirn
2608
2609     set fhl_dirn 0
2610 }
2611
2612 # Graph layout functions
2613
2614 proc shortids {ids} {
2615     set res {}
2616     foreach id $ids {
2617         if {[llength $id] > 1} {
2618             lappend res [shortids $id]
2619         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2620             lappend res [string range $id 0 7]
2621         } else {
2622             lappend res $id
2623         }
2624     }
2625     return $res
2626 }
2627
2628 proc incrange {l x o} {
2629     set n [llength $l]
2630     while {$x < $n} {
2631         set e [lindex $l $x]
2632         if {$e ne {}} {
2633             lset l $x [expr {$e + $o}]
2634         }
2635         incr x
2636     }
2637     return $l
2638 }
2639
2640 proc ntimes {n o} {
2641     set ret {}
2642     for {} {$n > 0} {incr n -1} {
2643         lappend ret $o
2644     }
2645     return $ret
2646 }
2647
2648 proc usedinrange {id l1 l2} {
2649     global children commitrow curview
2650
2651     if {[info exists commitrow($curview,$id)]} {
2652         set r $commitrow($curview,$id)
2653         if {$l1 <= $r && $r <= $l2} {
2654             return [expr {$r - $l1 + 1}]
2655         }
2656     }
2657     set kids $children($curview,$id)
2658     foreach c $kids {
2659         if {[info exists commitrow($curview,$c)]} {
2660             set r $commitrow($curview,$c)
2661             if {$l1 <= $r && $r <= $l2} {
2662                 return [expr {$r - $l1 + 1}]
2663             }
2664         }
2665     }
2666     return 0
2667 }
2668
2669 # Work out where id should go in idlist so that order-token
2670 # values increase from left to right
2671 proc idcol {idlist id {i 0}} {
2672     global ordertok curview
2673
2674     set t $ordertok($curview,$id)
2675     if {$i >= [llength $idlist] ||
2676         $t < $ordertok($curview,[lindex $idlist $i])} {
2677         if {$i > [llength $idlist]} {
2678             set i [llength $idlist]
2679         }
2680         while {[incr i -1] >= 0 &&
2681                $t < $ordertok($curview,[lindex $idlist $i])} {}
2682         incr i
2683     } else {
2684         if {$t > $ordertok($curview,[lindex $idlist $i])} {
2685             while {[incr i] < [llength $idlist] &&
2686                    $t >= $ordertok($curview,[lindex $idlist $i])} {}
2687         }
2688     }
2689     return $i
2690 }
2691
2692 proc makeuparrow {oid y x} {
2693     global rowidlist uparrowlen displayorder
2694
2695     for {set i 0} {$i < $uparrowlen && $y > 1} {incr i} {
2696         incr y -1
2697         set idl [lindex $rowidlist $y]
2698         set x [idcol $idl $oid $x]
2699         lset rowidlist $y [linsert $idl $x $oid]
2700     }
2701 }
2702
2703 proc initlayout {} {
2704     global rowidlist displayorder commitlisted
2705     global rowlaidout rowoptim
2706     global numcommits canvxmax canv
2707     global nextcolor
2708     global parentlist
2709     global colormap rowtextx
2710     global selectfirst
2711
2712     set numcommits 0
2713     set displayorder {}
2714     set commitlisted {}
2715     set parentlist {}
2716     set nextcolor 0
2717     set rowidlist {{}}
2718     set rowlaidout 0
2719     set rowoptim 0
2720     set canvxmax [$canv cget -width]
2721     catch {unset colormap}
2722     catch {unset rowtextx}
2723     set selectfirst 1
2724 }
2725
2726 proc setcanvscroll {} {
2727     global canv canv2 canv3 numcommits linespc canvxmax canvy0
2728
2729     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2730     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2731     $canv2 conf -scrollregion [list 0 0 0 $ymax]
2732     $canv3 conf -scrollregion [list 0 0 0 $ymax]
2733 }
2734
2735 proc visiblerows {} {
2736     global canv numcommits linespc
2737
2738     set ymax [lindex [$canv cget -scrollregion] 3]
2739     if {$ymax eq {} || $ymax == 0} return
2740     set f [$canv yview]
2741     set y0 [expr {int([lindex $f 0] * $ymax)}]
2742     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2743     if {$r0 < 0} {
2744         set r0 0
2745     }
2746     set y1 [expr {int([lindex $f 1] * $ymax)}]
2747     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2748     if {$r1 >= $numcommits} {
2749         set r1 [expr {$numcommits - 1}]
2750     }
2751     return [list $r0 $r1]
2752 }
2753
2754 proc layoutmore {tmax allread} {
2755     global rowlaidout rowoptim commitidx numcommits optim_delay
2756     global uparrowlen curview rowidlist
2757
2758     set showlast 0
2759     set showdelay $optim_delay
2760     set optdelay [expr {$uparrowlen + 1}]
2761     while {1} {
2762         if {$rowoptim - $showdelay > $numcommits} {
2763             showstuff [expr {$rowoptim - $showdelay}] $showlast
2764         } elseif {$rowlaidout - $optdelay > $rowoptim} {
2765             set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2766             if {$nr > 100} {
2767                 set nr 100
2768             }
2769             optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2770             incr rowoptim $nr
2771         } elseif {$commitidx($curview) > $rowlaidout} {
2772             set nr [expr {$commitidx($curview) - $rowlaidout}]
2773             # may need to increase this threshold if uparrowlen or
2774             # mingaplen are increased...
2775             if {$nr > 200} {
2776                 set nr 200
2777             }
2778             set row $rowlaidout
2779             set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2780             if {$rowlaidout == $row} {
2781                 return 0
2782             }
2783         } elseif {$allread} {
2784             set optdelay 0
2785             set nrows $commitidx($curview)
2786             if {[lindex $rowidlist $nrows] ne {}} {
2787                 layouttail
2788                 set rowlaidout $commitidx($curview)
2789             } elseif {$rowoptim == $nrows} {
2790                 set showdelay 0
2791                 set showlast 1
2792                 if {$numcommits == $nrows} {
2793                     return 0
2794                 }
2795             }
2796         } else {
2797             return 0
2798         }
2799         if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2800             return 1
2801         }
2802     }
2803 }
2804
2805 proc showstuff {canshow last} {
2806     global numcommits commitrow pending_select selectedline curview
2807     global lookingforhead mainheadid displayorder selectfirst
2808     global lastscrollset commitinterest
2809
2810     if {$numcommits == 0} {
2811         global phase
2812         set phase "incrdraw"
2813         allcanvs delete all
2814     }
2815     for {set l $numcommits} {$l < $canshow} {incr l} {
2816         set id [lindex $displayorder $l]
2817         if {[info exists commitinterest($id)]} {
2818             foreach script $commitinterest($id) {
2819                 eval [string map [list "%I" $id] $script]
2820             }
2821             unset commitinterest($id)
2822         }
2823     }
2824     set r0 $numcommits
2825     set prev $numcommits
2826     set numcommits $canshow
2827     set t [clock clicks -milliseconds]
2828     if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2829         set lastscrollset $t
2830         setcanvscroll
2831     }
2832     set rows [visiblerows]
2833     set r1 [lindex $rows 1]
2834     if {$r1 >= $canshow} {
2835         set r1 [expr {$canshow - 1}]
2836     }
2837     if {$r0 <= $r1} {
2838         drawcommits $r0 $r1
2839     }
2840     if {[info exists pending_select] &&
2841         [info exists commitrow($curview,$pending_select)] &&
2842         $commitrow($curview,$pending_select) < $numcommits} {
2843         selectline $commitrow($curview,$pending_select) 1
2844     }
2845     if {$selectfirst} {
2846         if {[info exists selectedline] || [info exists pending_select]} {
2847             set selectfirst 0
2848         } else {
2849             set l [first_real_row]
2850             selectline $l 1
2851             set selectfirst 0
2852         }
2853     }
2854     if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2855         && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2856         set lookingforhead 0
2857         dodiffindex
2858     }
2859 }
2860
2861 proc doshowlocalchanges {} {
2862     global lookingforhead curview mainheadid phase commitrow
2863
2864     if {[info exists commitrow($curview,$mainheadid)] &&
2865         ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2866         dodiffindex
2867     } elseif {$phase ne {}} {
2868         set lookingforhead 1
2869     }
2870 }
2871
2872 proc dohidelocalchanges {} {
2873     global lookingforhead localfrow localirow lserial
2874
2875     set lookingforhead 0
2876     if {$localfrow >= 0} {
2877         removerow $localfrow
2878         set localfrow -1
2879         if {$localirow > 0} {
2880             incr localirow -1
2881         }
2882     }
2883     if {$localirow >= 0} {
2884         removerow $localirow
2885         set localirow -1
2886     }
2887     incr lserial
2888 }
2889
2890 # spawn off a process to do git diff-index --cached HEAD
2891 proc dodiffindex {} {
2892     global localirow localfrow lserial
2893
2894     incr lserial
2895     set localfrow -1
2896     set localirow -1
2897     set fd [open "|git diff-index --cached HEAD" r]
2898     fconfigure $fd -blocking 0
2899     filerun $fd [list readdiffindex $fd $lserial]
2900 }
2901
2902 proc readdiffindex {fd serial} {
2903     global localirow commitrow mainheadid nullid2 curview
2904     global commitinfo commitdata lserial
2905
2906     set isdiff 1
2907     if {[gets $fd line] < 0} {
2908         if {![eof $fd]} {
2909             return 1
2910         }
2911         set isdiff 0
2912     }
2913     # we only need to see one line and we don't really care what it says...
2914     close $fd
2915
2916     # now see if there are any local changes not checked in to the index
2917     if {$serial == $lserial} {
2918         set fd [open "|git diff-files" r]
2919         fconfigure $fd -blocking 0
2920         filerun $fd [list readdifffiles $fd $serial]
2921     }
2922
2923     if {$isdiff && $serial == $lserial && $localirow == -1} {
2924         # add the line for the changes in the index to the graph
2925         set localirow $commitrow($curview,$mainheadid)
2926         set hl "Local changes checked in to index but not committed"
2927         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
2928         set commitdata($nullid2) "\n    $hl\n"
2929         insertrow $localirow $nullid2
2930     }
2931     return 0
2932 }
2933
2934 proc readdifffiles {fd serial} {
2935     global localirow localfrow commitrow mainheadid nullid curview
2936     global commitinfo commitdata lserial
2937
2938     set isdiff 1
2939     if {[gets $fd line] < 0} {
2940         if {![eof $fd]} {
2941             return 1
2942         }
2943         set isdiff 0
2944     }
2945     # we only need to see one line and we don't really care what it says...
2946     close $fd
2947
2948     if {$isdiff && $serial == $lserial && $localfrow == -1} {
2949         # add the line for the local diff to the graph
2950         if {$localirow >= 0} {
2951             set localfrow $localirow
2952             incr localirow
2953         } else {
2954             set localfrow $commitrow($curview,$mainheadid)
2955         }
2956         set hl "Local uncommitted changes, not checked in to index"
2957         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
2958         set commitdata($nullid) "\n    $hl\n"
2959         insertrow $localfrow $nullid
2960     }
2961     return 0
2962 }
2963
2964 proc nextuse {id row} {
2965     global commitrow curview children
2966
2967     if {[info exists children($curview,$id)]} {
2968         foreach kid $children($curview,$id) {
2969             if {[info exists commitrow($curview,$kid)] &&
2970                 $commitrow($curview,$kid) > $row} {
2971                 return $commitrow($curview,$kid)
2972             }
2973         }
2974     }
2975     if {[info exists commitrow($curview,$id)]} {
2976         return $commitrow($curview,$id)
2977     }
2978     return -1
2979 }
2980
2981 proc layoutrows {row endrow last} {
2982     global rowidlist displayorder
2983     global uparrowlen downarrowlen maxwidth mingaplen
2984     global children parentlist
2985     global commitidx curview
2986
2987     set idlist [lindex $rowidlist $row]
2988     if {!$last && $endrow + $uparrowlen + $mingaplen > $commitidx($curview)} {
2989         set endrow [expr {$commitidx($curview) - $uparrowlen - $mingaplen}]
2990     }
2991     while {$row < $endrow} {
2992         set id [lindex $displayorder $row]
2993         if {$row > $downarrowlen} {
2994             set termrow [expr {$row - $downarrowlen - 1}]
2995             foreach p [lindex $parentlist $termrow] {
2996                 set i [lsearch -exact $idlist $p]
2997                 if {$i < 0} continue
2998                 set nr [nextuse $p $termrow]
2999                 if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3000                     set idlist [lreplace $idlist $i $i]
3001                 }
3002             }
3003             lset rowidlist $row $idlist
3004         }
3005         set oldolds {}
3006         set newolds {}
3007         foreach p [lindex $parentlist $row] {
3008             # is id the first child of this parent?
3009             if {$id eq [lindex $children($curview,$p) 0]} {
3010                 lappend newolds $p
3011             } elseif {[lsearch -exact $idlist $p] < 0} {
3012                 lappend oldolds $p
3013             }
3014         }
3015         set col [lsearch -exact $idlist $id]
3016         if {$col < 0} {
3017             set col [idcol $idlist $id]
3018             set idlist [linsert $idlist $col $id]
3019             lset rowidlist $row $idlist
3020             if {$children($curview,$id) ne {}} {
3021                 makeuparrow $id $row $col
3022             }
3023         }
3024         incr row
3025         set idlist [lreplace $idlist $col $col]
3026         set x $col
3027         foreach i $newolds {
3028             set x [idcol $idlist $i $x]
3029             set idlist [linsert $idlist $x $i]
3030         }
3031         foreach oid $oldolds {
3032             set x [idcol $idlist $oid $x]
3033             set idlist [linsert $idlist $x $oid]
3034             makeuparrow $oid $row $x
3035         }
3036         lappend rowidlist $idlist
3037     }
3038     return $row
3039 }
3040
3041 proc addextraid {id row} {
3042     global displayorder commitrow commitinfo
3043     global commitidx commitlisted
3044     global parentlist children curview
3045
3046     incr commitidx($curview)
3047     lappend displayorder $id
3048     lappend commitlisted 0
3049     lappend parentlist {}
3050     set commitrow($curview,$id) $row
3051     readcommit $id
3052     if {![info exists commitinfo($id)]} {
3053         set commitinfo($id) {"No commit information available"}
3054     }
3055     if {![info exists children($curview,$id)]} {
3056         set children($curview,$id) {}
3057     }
3058 }
3059
3060 proc layouttail {} {
3061     global rowidlist commitidx curview
3062
3063     set row $commitidx($curview)
3064     set idlist [lindex $rowidlist $row]
3065     while {$idlist ne {}} {
3066         set col [expr {[llength $idlist] - 1}]
3067         set id [lindex $idlist $col]
3068         addextraid $id $row
3069         incr row
3070         set idlist [lreplace $idlist $col $col]
3071         lappend rowidlist $idlist
3072     }
3073 }
3074
3075 proc insert_pad {row col npad} {
3076     global rowidlist
3077
3078     set pad [ntimes $npad {}]
3079     set idlist [lindex $rowidlist $row]
3080     set bef [lrange $idlist 0 [expr {$col - 1}]]
3081     set aft [lrange $idlist $col end]
3082     set i [lsearch -exact $aft {}]
3083     if {$i > 0} {
3084         set aft [lreplace $aft $i $i]
3085     }
3086     lset rowidlist $row [concat $bef $pad $aft]
3087 }
3088
3089 proc optimize_rows {row col endrow} {
3090     global rowidlist displayorder curview children
3091
3092     if {$row < 1} {
3093         set row 1
3094     }
3095     set idlist [lindex $rowidlist [expr {$row - 1}]]
3096     if {$row >= 2} {
3097         set previdlist [lindex $rowidlist [expr {$row - 2}]]
3098     } else {
3099         set previdlist {}
3100     }
3101     for {} {$row < $endrow} {incr row} {
3102         set pprevidlist $previdlist
3103         set previdlist $idlist
3104         set idlist [lindex $rowidlist $row]
3105         set haspad 0
3106         set y0 [expr {$row - 1}]
3107         set ym [expr {$row - 2}]
3108         set x0 -1
3109         set xm -1
3110         for {} {$col < [llength $idlist]} {incr col} {
3111             set id [lindex $idlist $col]
3112             if {[lindex $previdlist $col] eq $id} continue
3113             if {$id eq {}} {
3114                 set haspad 1
3115                 continue
3116             }
3117             set x0 [lsearch -exact $previdlist $id]
3118             if {$x0 < 0} continue
3119             set z [expr {$x0 - $col}]
3120             set isarrow 0
3121             set z0 {}
3122             if {$ym >= 0} {
3123                 set xm [lsearch -exact $pprevidlist $id]
3124                 if {$xm >= 0} {
3125                     set z0 [expr {$xm - $x0}]
3126                 }
3127             }
3128             if {$z0 eq {}} {
3129                 # if row y0 is the first child of $id then it's not an arrow
3130                 if {[lindex $children($curview,$id) 0] ne
3131                     [lindex $displayorder $y0]} {
3132                     set isarrow 1
3133                 }
3134             }
3135             if {!$isarrow && $id ne [lindex $displayorder $row] &&
3136                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3137                 set isarrow 1
3138             }
3139             # Looking at lines from this row to the previous row,
3140             # make them go straight up if they end in an arrow on
3141             # the previous row; otherwise make them go straight up
3142             # or at 45 degrees.
3143             if {$z < -1 || ($z < 0 && $isarrow)} {
3144                 # Line currently goes left too much;
3145                 # insert pads in the previous row, then optimize it
3146                 set npad [expr {-1 - $z + $isarrow}]
3147                 insert_pad $y0 $x0 $npad
3148                 if {$y0 > 0} {
3149                     optimize_rows $y0 $x0 $row
3150                 }
3151                 set previdlist [lindex $rowidlist $y0]
3152                 set x0 [lsearch -exact $previdlist $id]
3153                 set z [expr {$x0 - $col}]
3154                 if {$z0 ne {}} {
3155                     set pprevidlist [lindex $rowidlist $ym]
3156                     set xm [lsearch -exact $pprevidlist $id]
3157                     set z0 [expr {$xm - $x0}]
3158                 }
3159             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3160                 # Line currently goes right too much;
3161                 # insert pads in this line
3162                 set npad [expr {$z - 1 + $isarrow}]
3163                 insert_pad $row $col $npad
3164                 set idlist [lindex $rowidlist $row]
3165                 incr col $npad
3166                 set z [expr {$x0 - $col}]
3167                 set haspad 1
3168             }
3169             if {$z0 eq {} && !$isarrow && $ym >= 0} {
3170                 # this line links to its first child on row $row-2
3171                 set id [lindex $displayorder $ym]
3172                 set xc [lsearch -exact $pprevidlist $id]
3173                 if {$xc >= 0} {
3174                     set z0 [expr {$xc - $x0}]
3175                 }
3176             }
3177             # avoid lines jigging left then immediately right
3178             if {$z0 ne {} && $z < 0 && $z0 > 0} {
3179                 insert_pad $y0 $x0 1
3180                 incr x0
3181                 optimize_rows $y0 $x0 $row
3182                 set previdlist [lindex $rowidlist $y0]
3183                 set pprevidlist [lindex $rowidlist $ym]
3184             }
3185         }
3186         if {!$haspad} {
3187             # Find the first column that doesn't have a line going right
3188             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3189                 set id [lindex $idlist $col]
3190                 if {$id eq {}} break
3191                 set x0 [lsearch -exact $previdlist $id]
3192                 if {$x0 < 0} {
3193                     # check if this is the link to the first child
3194                     set kid [lindex $displayorder $y0]
3195                     if {[lindex $children($curview,$id) 0] eq $kid} {
3196                         # it is, work out offset to child
3197                         set x0 [lsearch -exact $previdlist $kid]
3198                     }
3199                 }
3200                 if {$x0 <= $col} break
3201             }
3202             # Insert a pad at that column as long as it has a line and
3203             # isn't the last column
3204             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3205                 set idlist [linsert $idlist $col {}]
3206             }
3207         }
3208         lset rowidlist $row $idlist
3209         set col 0
3210     }
3211 }
3212
3213 proc xc {row col} {
3214     global canvx0 linespc
3215     return [expr {$canvx0 + $col * $linespc}]
3216 }
3217
3218 proc yc {row} {
3219     global canvy0 linespc
3220     return [expr {$canvy0 + $row * $linespc}]
3221 }
3222
3223 proc linewidth {id} {
3224     global thickerline lthickness
3225
3226     set wid $lthickness
3227     if {[info exists thickerline] && $id eq $thickerline} {
3228         set wid [expr {2 * $lthickness}]
3229     }
3230     return $wid
3231 }
3232
3233 proc rowranges {id} {
3234     global commitrow curview children uparrowlen downarrowlen
3235     global rowidlist
3236
3237     set kids $children($curview,$id)
3238     if {$kids eq {}} {
3239         return {}
3240     }
3241     set ret {}
3242     lappend kids $id
3243     foreach child $kids {
3244         if {![info exists commitrow($curview,$child)]} break
3245         set row $commitrow($curview,$child)
3246         if {![info exists prev]} {
3247             lappend ret [expr {$row + 1}]
3248         } else {
3249             if {$row <= $prevrow} {
3250                 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3251             }
3252             # see if the line extends the whole way from prevrow to row
3253             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3254                 [lsearch -exact [lindex $rowidlist \
3255                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3256                 # it doesn't, see where it ends
3257                 set r [expr {$prevrow + $downarrowlen}]
3258                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3259                     while {[incr r -1] > $prevrow &&
3260                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3261                 } else {
3262                     while {[incr r] <= $row &&
3263                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3264                     incr r -1
3265                 }
3266                 lappend ret $r
3267                 # see where it starts up again
3268                 set r [expr {$row - $uparrowlen}]
3269                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3270                     while {[incr r] < $row &&
3271                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3272                 } else {
3273                     while {[incr r -1] >= $prevrow &&
3274                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3275                     incr r
3276                 }
3277                 lappend ret $r
3278             }
3279         }
3280         if {$child eq $id} {
3281             lappend ret $row
3282         }
3283         set prev $id
3284         set prevrow $row
3285     }
3286     return $ret
3287 }
3288
3289 proc drawlineseg {id row endrow arrowlow} {
3290     global rowidlist displayorder iddrawn linesegs
3291     global canv colormap linespc curview maxlinelen parentlist
3292
3293     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3294     set le [expr {$row + 1}]
3295     set arrowhigh 1
3296     while {1} {
3297         set c [lsearch -exact [lindex $rowidlist $le] $id]
3298         if {$c < 0} {
3299             incr le -1
3300             break
3301         }
3302         lappend cols $c
3303         set x [lindex $displayorder $le]
3304         if {$x eq $id} {
3305             set arrowhigh 0
3306             break
3307         }
3308         if {[info exists iddrawn($x)] || $le == $endrow} {
3309             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3310             if {$c >= 0} {
3311                 lappend cols $c
3312                 set arrowhigh 0
3313             }
3314             break
3315         }
3316         incr le
3317     }
3318     if {$le <= $row} {
3319         return $row
3320     }
3321
3322     set lines {}
3323     set i 0
3324     set joinhigh 0
3325     if {[info exists linesegs($id)]} {
3326         set lines $linesegs($id)
3327         foreach li $lines {
3328             set r0 [lindex $li 0]
3329             if {$r0 > $row} {
3330                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3331                     set joinhigh 1
3332                 }
3333                 break
3334             }
3335             incr i
3336         }
3337     }
3338     set joinlow 0
3339     if {$i > 0} {
3340         set li [lindex $lines [expr {$i-1}]]
3341         set r1 [lindex $li 1]
3342         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3343             set joinlow 1
3344         }
3345     }
3346
3347     set x [lindex $cols [expr {$le - $row}]]
3348     set xp [lindex $cols [expr {$le - 1 - $row}]]
3349     set dir [expr {$xp - $x}]
3350     if {$joinhigh} {
3351         set ith [lindex $lines $i 2]
3352         set coords [$canv coords $ith]
3353         set ah [$canv itemcget $ith -arrow]
3354         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3355         set x2 [lindex $cols [expr {$le + 1 - $row}]]
3356         if {$x2 ne {} && $x - $x2 == $dir} {
3357             set coords [lrange $coords 0 end-2]
3358         }
3359     } else {
3360         set coords [list [xc $le $x] [yc $le]]
3361     }
3362     if {$joinlow} {
3363         set itl [lindex $lines [expr {$i-1}] 2]
3364         set al [$canv itemcget $itl -arrow]
3365         set arrowlow [expr {$al eq "last" || $al eq "both"}]
3366     } elseif {$arrowlow} {
3367         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3368             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3369             set arrowlow 0
3370         }
3371     }
3372     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3373     for {set y $le} {[incr y -1] > $row} {} {
3374         set x $xp
3375         set xp [lindex $cols [expr {$y - 1 - $row}]]
3376         set ndir [expr {$xp - $x}]
3377         if {$dir != $ndir || $xp < 0} {
3378             lappend coords [xc $y $x] [yc $y]
3379         }
3380         set dir $ndir
3381     }
3382     if {!$joinlow} {
3383         if {$xp < 0} {
3384             # join parent line to first child
3385             set ch [lindex $displayorder $row]
3386             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3387             if {$xc < 0} {
3388                 puts "oops: drawlineseg: child $ch not on row $row"
3389             } elseif {$xc != $x} {
3390                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3391                     set d [expr {int(0.5 * $linespc)}]
3392                     set x1 [xc $row $x]
3393                     if {$xc < $x} {
3394                         set x2 [expr {$x1 - $d}]
3395                     } else {
3396                         set x2 [expr {$x1 + $d}]
3397                     }
3398                     set y2 [yc $row]
3399                     set y1 [expr {$y2 + $d}]
3400                     lappend coords $x1 $y1 $x2 $y2
3401                 } elseif {$xc < $x - 1} {
3402                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
3403                 } elseif {$xc > $x + 1} {
3404                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
3405                 }
3406                 set x $xc
3407             }
3408             lappend coords [xc $row $x] [yc $row]
3409         } else {
3410             set xn [xc $row $xp]
3411             set yn [yc $row]
3412             lappend coords $xn $yn
3413         }
3414         if {!$joinhigh} {
3415             assigncolor $id
3416             set t [$canv create line $coords -width [linewidth $id] \
3417                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
3418             $canv lower $t
3419             bindline $t $id
3420             set lines [linsert $lines $i [list $row $le $t]]
3421         } else {
3422             $canv coords $ith $coords
3423             if {$arrow ne $ah} {
3424                 $canv itemconf $ith -arrow $arrow
3425             }
3426             lset lines $i 0 $row
3427         }
3428     } else {
3429         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3430         set ndir [expr {$xo - $xp}]
3431         set clow [$canv coords $itl]
3432         if {$dir == $ndir} {
3433             set clow [lrange $clow 2 end]
3434         }
3435         set coords [concat $coords $clow]
3436         if {!$joinhigh} {
3437             lset lines [expr {$i-1}] 1 $le
3438         } else {
3439             # coalesce two pieces
3440             $canv delete $ith
3441             set b [lindex $lines [expr {$i-1}] 0]
3442             set e [lindex $lines $i 1]
3443             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3444         }
3445         $canv coords $itl $coords
3446         if {$arrow ne $al} {
3447             $canv itemconf $itl -arrow $arrow
3448         }
3449     }
3450
3451     set linesegs($id) $lines
3452     return $le
3453 }
3454
3455 proc drawparentlinks {id row} {
3456     global rowidlist canv colormap curview parentlist
3457     global idpos linespc
3458
3459     set rowids [lindex $rowidlist $row]
3460     set col [lsearch -exact $rowids $id]
3461     if {$col < 0} return
3462     set olds [lindex $parentlist $row]
3463     set row2 [expr {$row + 1}]
3464     set x [xc $row $col]
3465     set y [yc $row]
3466     set y2 [yc $row2]
3467     set d [expr {int(0.5 * $linespc)}]
3468     set ymid [expr {$y + $d}]
3469     set ids [lindex $rowidlist $row2]
3470     # rmx = right-most X coord used
3471     set rmx 0
3472     foreach p $olds {
3473         set i [lsearch -exact $ids $p]
3474         if {$i < 0} {
3475             puts "oops, parent $p of $id not in list"
3476             continue
3477         }
3478         set x2 [xc $row2 $i]
3479         if {$x2 > $rmx} {
3480             set rmx $x2
3481         }
3482         set j [lsearch -exact $rowids $p]
3483         if {$j < 0} {
3484             # drawlineseg will do this one for us
3485             continue
3486         }
3487         assigncolor $p
3488         # should handle duplicated parents here...
3489         set coords [list $x $y]
3490         if {$i != $col} {
3491             # if attaching to a vertical segment, draw a smaller
3492             # slant for visual distinctness
3493             if {$i == $j} {
3494                 if {$i < $col} {
3495                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3496                 } else {
3497                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3498                 }
3499             } elseif {$i < $col && $i < $j} {
3500                 # segment slants towards us already
3501                 lappend coords [xc $row $j] $y
3502             } else {
3503                 if {$i < $col - 1} {
3504                     lappend coords [expr {$x2 + $linespc}] $y
3505                 } elseif {$i > $col + 1} {
3506                     lappend coords [expr {$x2 - $linespc}] $y
3507                 }
3508                 lappend coords $x2 $y2
3509             }
3510         } else {
3511             lappend coords $x2 $y2
3512         }
3513         set t [$canv create line $coords -width [linewidth $p] \
3514                    -fill $colormap($p) -tags lines.$p]
3515         $canv lower $t
3516         bindline $t $p
3517     }
3518     if {$rmx > [lindex $idpos($id) 1]} {
3519         lset idpos($id) 1 $rmx
3520         redrawtags $id
3521     }
3522 }
3523
3524 proc drawlines {id} {
3525     global canv
3526
3527     $canv itemconf lines.$id -width [linewidth $id]
3528 }
3529
3530 proc drawcmittext {id row col} {
3531     global linespc canv canv2 canv3 canvy0 fgcolor curview
3532     global commitlisted commitinfo rowidlist parentlist
3533     global rowtextx idpos idtags idheads idotherrefs
3534     global linehtag linentag linedtag
3535     global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3536
3537     # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3538     set listed [lindex $commitlisted $row]
3539     if {$id eq $nullid} {
3540         set ofill red
3541     } elseif {$id eq $nullid2} {
3542         set ofill green
3543     } else {
3544         set ofill [expr {$listed != 0? "blue": "white"}]
3545     }
3546     set x [xc $row $col]
3547     set y [yc $row]
3548     set orad [expr {$linespc / 3}]
3549     if {$listed <= 1} {
3550         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3551                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3552                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3553     } elseif {$listed == 2} {
3554         # triangle pointing left for left-side commits
3555         set t [$canv create polygon \
3556                    [expr {$x - $orad}] $y \
3557                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3558                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3559                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3560     } else {
3561         # triangle pointing right for right-side commits
3562         set t [$canv create polygon \
3563                    [expr {$x + $orad - 1}] $y \
3564                    [expr {$x - $orad}] [expr {$y - $orad}] \
3565                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3566                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3567     }
3568     $canv raise $t
3569     $canv bind $t <1> {selcanvline {} %x %y}
3570     set rmx [llength [lindex $rowidlist $row]]
3571     set olds [lindex $parentlist $row]
3572     if {$olds ne {}} {
3573         set nextids [lindex $rowidlist [expr {$row + 1}]]
3574         foreach p $olds {
3575             set i [lsearch -exact $nextids $p]
3576             if {$i > $rmx} {
3577                 set rmx $i
3578             }
3579         }
3580     }
3581     set xt [xc $row $rmx]
3582     set rowtextx($row) $xt
3583     set idpos($id) [list $x $xt $y]
3584     if {[info exists idtags($id)] || [info exists idheads($id)]
3585         || [info exists idotherrefs($id)]} {
3586         set xt [drawtags $id $x $xt $y]
3587     }
3588     set headline [lindex $commitinfo($id) 0]
3589     set name [lindex $commitinfo($id) 1]
3590     set date [lindex $commitinfo($id) 2]
3591     set date [formatdate $date]
3592     set font $mainfont
3593     set nfont $mainfont
3594     set isbold [ishighlighted $row]
3595     if {$isbold > 0} {
3596         lappend boldrows $row
3597         lappend font bold
3598         if {$isbold > 1} {
3599             lappend boldnamerows $row
3600             lappend nfont bold
3601         }
3602     }
3603     set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3604                             -text $headline -font $font -tags text]
3605     $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3606     set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3607                             -text $name -font $nfont -tags text]
3608     set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3609                             -text $date -font $mainfont -tags text]
3610     set xr [expr {$xt + [font measure $mainfont $headline]}]
3611     if {$xr > $canvxmax} {
3612         set canvxmax $xr
3613         setcanvscroll
3614     }
3615 }
3616
3617 proc drawcmitrow {row} {
3618     global displayorder rowidlist
3619     global iddrawn markingmatches
3620     global commitinfo parentlist numcommits
3621     global filehighlight fhighlights findstring nhighlights
3622     global hlview vhighlights
3623     global highlight_related rhighlights
3624
3625     if {$row >= $numcommits} return
3626
3627     set id [lindex $displayorder $row]
3628     if {[info exists hlview] && ![info exists vhighlights($row)]} {
3629         askvhighlight $row $id
3630     }
3631     if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3632         askfilehighlight $row $id
3633     }
3634     if {$findstring ne {} && ![info exists nhighlights($row)]} {
3635         askfindhighlight $row $id
3636     }
3637     if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3638         askrelhighlight $row $id
3639     }
3640     if {![info exists iddrawn($id)]} {
3641         set col [lsearch -exact [lindex $rowidlist $row] $id]
3642         if {$col < 0} {
3643             puts "oops, row $row id $id not in list"
3644             return
3645         }
3646         if {![info exists commitinfo($id)]} {
3647             getcommit $id
3648         }
3649         assigncolor $id
3650         drawcmittext $id $row $col
3651         set iddrawn($id) 1
3652     }
3653     if {$markingmatches} {
3654         markrowmatches $row $id
3655     }
3656 }
3657
3658 proc drawcommits {row {endrow {}}} {
3659     global numcommits iddrawn displayorder curview
3660     global parentlist rowidlist
3661
3662     if {$row < 0} {
3663         set row 0
3664     }
3665     if {$endrow eq {}} {
3666         set endrow $row
3667     }
3668     if {$endrow >= $numcommits} {
3669         set endrow [expr {$numcommits - 1}]
3670     }
3671
3672     # make the lines join to already-drawn rows either side
3673     set r [expr {$row - 1}]
3674     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3675         set r $row
3676     }
3677     set er [expr {$endrow + 1}]
3678     if {$er >= $numcommits ||
3679         ![info exists iddrawn([lindex $displayorder $er])]} {
3680         set er $endrow
3681     }
3682     for {} {$r <= $er} {incr r} {
3683         set id [lindex $displayorder $r]
3684         set wasdrawn [info exists iddrawn($id)]
3685         drawcmitrow $r
3686         if {$r == $er} break
3687         set nextid [lindex $displayorder [expr {$r + 1}]]
3688         if {$wasdrawn && [info exists iddrawn($nextid)]} {
3689             catch {unset prevlines}
3690             continue
3691         }
3692         drawparentlinks $id $r
3693
3694         if {[info exists lineends($r)]} {
3695             foreach lid $lineends($r) {
3696                 unset prevlines($lid)
3697             }
3698         }
3699         set rowids [lindex $rowidlist $r]
3700         foreach lid $rowids {
3701             if {$lid eq {}} continue
3702             if {$lid eq $id} {
3703                 # see if this is the first child of any of its parents
3704                 foreach p [lindex $parentlist $r] {
3705                     if {[lsearch -exact $rowids $p] < 0} {
3706                         # make this line extend up to the child
3707                         set le [drawlineseg $p $r $er 0]
3708                         lappend lineends($le) $p
3709                         set prevlines($p) 1
3710                     }
3711                 }
3712             } elseif {![info exists prevlines($lid)]} {
3713                 set le [drawlineseg $lid $r $er 1]
3714                 lappend lineends($le) $lid
3715                 set prevlines($lid) 1
3716             }
3717         }
3718     }
3719 }
3720
3721 proc drawfrac {f0 f1} {
3722     global canv linespc
3723
3724     set ymax [lindex [$canv cget -scrollregion] 3]
3725     if {$ymax eq {} || $ymax == 0} return
3726     set y0 [expr {int($f0 * $ymax)}]
3727     set row [expr {int(($y0 - 3) / $linespc) - 1}]
3728     set y1 [expr {int($f1 * $ymax)}]
3729     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3730     drawcommits $row $endrow
3731 }
3732
3733 proc drawvisible {} {
3734     global canv
3735     eval drawfrac [$canv yview]
3736 }
3737
3738 proc clear_display {} {
3739     global iddrawn linesegs
3740     global vhighlights fhighlights nhighlights rhighlights
3741
3742     allcanvs delete all
3743     catch {unset iddrawn}
3744     catch {unset linesegs}
3745     catch {unset vhighlights}
3746     catch {unset fhighlights}
3747     catch {unset nhighlights}
3748     catch {unset rhighlights}
3749 }
3750
3751 proc findcrossings {id} {
3752     global rowidlist parentlist numcommits displayorder
3753
3754     set cross {}
3755     set ccross {}
3756     foreach {s e} [rowranges $id] {
3757         if {$e >= $numcommits} {
3758             set e [expr {$numcommits - 1}]
3759         }
3760         if {$e <= $s} continue
3761         for {set row $e} {[incr row -1] >= $s} {} {
3762             set x [lsearch -exact [lindex $rowidlist $row] $id]
3763             if {$x < 0} break
3764             set olds [lindex $parentlist $row]
3765             set kid [lindex $displayorder $row]
3766             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3767             if {$kidx < 0} continue
3768             set nextrow [lindex $rowidlist [expr {$row + 1}]]
3769             foreach p $olds {
3770                 set px [lsearch -exact $nextrow $p]
3771                 if {$px < 0} continue
3772                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3773                     if {[lsearch -exact $ccross $p] >= 0} continue
3774                     if {$x == $px + ($kidx < $px? -1: 1)} {
3775                         lappend ccross $p
3776                     } elseif {[lsearch -exact $cross $p] < 0} {
3777                         lappend cross $p
3778                     }
3779                 }
3780             }
3781         }
3782     }
3783     return [concat $ccross {{}} $cross]
3784 }
3785
3786 proc assigncolor {id} {
3787     global colormap colors nextcolor
3788     global commitrow parentlist children children curview
3789
3790     if {[info exists colormap($id)]} return
3791     set ncolors [llength $colors]
3792     if {[info exists children($curview,$id)]} {
3793         set kids $children($curview,$id)
3794     } else {
3795         set kids {}
3796     }
3797     if {[llength $kids] == 1} {
3798         set child [lindex $kids 0]
3799         if {[info exists colormap($child)]
3800             && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3801             set colormap($id) $colormap($child)
3802             return
3803         }
3804     }
3805     set badcolors {}
3806     set origbad {}
3807     foreach x [findcrossings $id] {
3808         if {$x eq {}} {
3809             # delimiter between corner crossings and other crossings
3810             if {[llength $badcolors] >= $ncolors - 1} break
3811             set origbad $badcolors
3812         }
3813         if {[info exists colormap($x)]
3814             && [lsearch -exact $badcolors $colormap($x)] < 0} {
3815             lappend badcolors $colormap($x)
3816         }
3817     }
3818     if {[llength $badcolors] >= $ncolors} {
3819         set badcolors $origbad
3820     }
3821     set origbad $badcolors
3822     if {[llength $badcolors] < $ncolors - 1} {
3823         foreach child $kids {
3824             if {[info exists colormap($child)]
3825                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3826                 lappend badcolors $colormap($child)
3827             }
3828             foreach p [lindex $parentlist $commitrow($curview,$child)] {
3829                 if {[info exists colormap($p)]
3830                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
3831                     lappend badcolors $colormap($p)
3832                 }
3833             }
3834         }
3835         if {[llength $badcolors] >= $ncolors} {
3836             set badcolors $origbad
3837         }
3838     }
3839     for {set i 0} {$i <= $ncolors} {incr i} {
3840         set c [lindex $colors $nextcolor]
3841         if {[incr nextcolor] >= $ncolors} {
3842             set nextcolor 0
3843         }
3844         if {[lsearch -exact $badcolors $c]} break
3845     }
3846     set colormap($id) $c
3847 }
3848
3849 proc bindline {t id} {
3850     global canv
3851
3852     $canv bind $t <Enter> "lineenter %x %y $id"
3853     $canv bind $t <Motion> "linemotion %x %y $id"
3854     $canv bind $t <Leave> "lineleave $id"
3855     $canv bind $t <Button-1> "lineclick %x %y $id 1"
3856 }
3857
3858 proc drawtags {id x xt y1} {
3859     global idtags idheads idotherrefs mainhead
3860     global linespc lthickness
3861     global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3862
3863     set marks {}
3864     set ntags 0
3865     set nheads 0
3866     if {[info exists idtags($id)]} {
3867         set marks $idtags($id)
3868         set ntags [llength $marks]
3869     }
3870     if {[info exists idheads($id)]} {
3871         set marks [concat $marks $idheads($id)]
3872         set nheads [llength $idheads($id)]
3873     }
3874     if {[info exists idotherrefs($id)]} {
3875         set marks [concat $marks $idotherrefs($id)]
3876     }
3877     if {$marks eq {}} {
3878         return $xt
3879     }
3880
3881     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3882     set yt [expr {$y1 - 0.5 * $linespc}]
3883     set yb [expr {$yt + $linespc - 1}]
3884     set xvals {}
3885     set wvals {}
3886     set i -1
3887     foreach tag $marks {
3888         incr i
3889         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3890             set wid [font measure [concat $mainfont bold] $tag]
3891         } else {
3892             set wid [font measure $mainfont $tag]
3893         }
3894         lappend xvals $xt
3895         lappend wvals $wid
3896         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3897     }
3898     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3899                -width $lthickness -fill black -tags tag.$id]
3900     $canv lower $t
3901     foreach tag $marks x $xvals wid $wvals {
3902         set xl [expr {$x + $delta}]
3903         set xr [expr {$x + $delta + $wid + $lthickness}]
3904         set font $mainfont
3905         if {[incr ntags -1] >= 0} {
3906             # draw a tag
3907             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3908                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3909                        -width 1 -outline black -fill yellow -tags tag.$id]
3910             $canv bind $t <1> [list showtag $tag 1]
3911             set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3912         } else {
3913             # draw a head or other ref
3914             if {[incr nheads -1] >= 0} {
3915                 set col green
3916                 if {$tag eq $mainhead} {
3917                     lappend font bold
3918                 }
3919             } else {
3920                 set col "#ddddff"
3921             }
3922             set xl [expr {$xl - $delta/2}]
3923             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3924                 -width 1 -outline black -fill $col -tags tag.$id
3925             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3926                 set rwid [font measure $mainfont $remoteprefix]
3927                 set xi [expr {$x + 1}]
3928                 set yti [expr {$yt + 1}]
3929                 set xri [expr {$x + $rwid}]
3930                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3931                         -width 0 -fill "#ffddaa" -tags tag.$id
3932             }
3933         }
3934         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3935                    -font $font -tags [list tag.$id text]]
3936         if {$ntags >= 0} {
3937             $canv bind $t <1> [list showtag $tag 1]
3938         } elseif {$nheads >= 0} {
3939             $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3940         }
3941     }
3942     return $xt
3943 }
3944
3945 proc xcoord {i level ln} {
3946     global canvx0 xspc1 xspc2
3947
3948     set x [expr {$canvx0 + $i * $xspc1($ln)}]
3949     if {$i > 0 && $i == $level} {
3950         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3951     } elseif {$i > $level} {
3952         set x [expr {$x + $xspc2 - $xspc1($ln)}]
3953     }
3954     return $x
3955 }
3956
3957 proc show_status {msg} {
3958     global canv mainfont fgcolor
3959
3960     clear_display
3961     $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3962         -tags text -fill $fgcolor
3963 }
3964
3965 # Insert a new commit as the child of the commit on row $row.
3966 # The new commit will be displayed on row $row and the commits
3967 # on that row and below will move down one row.
3968 proc insertrow {row newcmit} {
3969     global displayorder parentlist commitlisted children
3970     global commitrow curview rowidlist numcommits
3971     global rowlaidout rowoptim numcommits
3972     global selectedline commitidx
3973
3974     if {$row >= $numcommits} {
3975         puts "oops, inserting new row $row but only have $numcommits rows"
3976         return
3977     }
3978     set p [lindex $displayorder $row]
3979     set displayorder [linsert $displayorder $row $newcmit]
3980     set parentlist [linsert $parentlist $row $p]
3981     set kids $children($curview,$p)
3982     lappend kids $newcmit
3983     set children($curview,$p) $kids
3984     set children($curview,$newcmit) {}
3985     set commitlisted [linsert $commitlisted $row 1]
3986     set l [llength $displayorder]
3987     for {set r $row} {$r < $l} {incr r} {
3988         set id [lindex $displayorder $r]
3989         set commitrow($curview,$id) $r
3990     }
3991     incr commitidx($curview)
3992
3993     set idlist [lindex $rowidlist $row]
3994     if {[llength $kids] == 1} {
3995         set col [lsearch -exact $idlist $p]
3996         lset idlist $col $newcmit
3997     } else {
3998         set col [llength $idlist]
3999         lappend idlist $newcmit
4000     }
4001     set rowidlist [linsert $rowidlist $row $idlist]
4002
4003     incr rowlaidout
4004     incr rowoptim
4005     incr numcommits
4006
4007     if {[info exists selectedline] && $selectedline >= $row} {
4008         incr selectedline
4009     }
4010     redisplay
4011 }
4012
4013 # Remove a commit that was inserted with insertrow on row $row.
4014 proc removerow {row} {
4015     global displayorder parentlist commitlisted children
4016     global commitrow curview rowidlist numcommits
4017     global rowlaidout rowoptim numcommits
4018     global linesegends selectedline commitidx
4019
4020     if {$row >= $numcommits} {
4021         puts "oops, removing row $row but only have $numcommits rows"
4022         return
4023     }
4024     set rp1 [expr {$row + 1}]
4025     set id [lindex $displayorder $row]
4026     set p [lindex $parentlist $row]
4027     set displayorder [lreplace $displayorder $row $row]
4028     set parentlist [lreplace $parentlist $row $row]
4029     set commitlisted [lreplace $commitlisted $row $row]
4030     set kids $children($curview,$p)
4031     set i [lsearch -exact $kids $id]
4032     if {$i >= 0} {
4033         set kids [lreplace $kids $i $i]
4034         set children($curview,$p) $kids
4035     }
4036     set l [llength $displayorder]
4037     for {set r $row} {$r < $l} {incr r} {
4038         set id [lindex $displayorder $r]
4039         set commitrow($curview,$id) $r
4040     }
4041     incr commitidx($curview) -1
4042
4043     set rowidlist [lreplace $rowidlist $row $row]
4044
4045     incr rowlaidout -1
4046     incr rowoptim -1
4047     incr numcommits -1
4048
4049     if {[info exists selectedline] && $selectedline > $row} {
4050         incr selectedline -1
4051     }
4052     redisplay
4053 }
4054
4055 # Don't change the text pane cursor if it is currently the hand cursor,
4056 # showing that we are over a sha1 ID link.
4057 proc settextcursor {c} {
4058     global ctext curtextcursor
4059
4060     if {[$ctext cget -cursor] == $curtextcursor} {
4061         $ctext config -cursor $c
4062     }
4063     set curtextcursor $c
4064 }
4065
4066 proc nowbusy {what} {
4067     global isbusy
4068
4069     if {[array names isbusy] eq {}} {
4070         . config -cursor watch
4071         settextcursor watch
4072     }
4073     set isbusy($what) 1
4074 }
4075
4076 proc notbusy {what} {
4077     global isbusy maincursor textcursor
4078
4079     catch {unset isbusy($what)}
4080     if {[array names isbusy] eq {}} {
4081         . config -cursor $maincursor
4082         settextcursor $textcursor
4083     }
4084 }
4085
4086 proc findmatches {f} {
4087     global findtype findstring
4088     if {$findtype == "Regexp"} {
4089         set matches [regexp -indices -all -inline $findstring $f]
4090     } else {
4091         set fs $findstring
4092         if {$findtype == "IgnCase"} {
4093             set f [string tolower $f]
4094             set fs [string tolower $fs]
4095         }
4096         set matches {}
4097         set i 0
4098         set l [string length $fs]
4099         while {[set j [string first $fs $f $i]] >= 0} {
4100             lappend matches [list $j [expr {$j+$l-1}]]
4101             set i [expr {$j + $l}]
4102         }
4103     }
4104     return $matches
4105 }
4106
4107 proc dofind {{rev 0}} {
4108     global findstring findstartline findcurline selectedline numcommits
4109
4110     unmarkmatches
4111     cancel_next_highlight
4112     focus .
4113     if {$findstring eq {} || $numcommits == 0} return
4114     if {![info exists selectedline]} {
4115         set findstartline [lindex [visiblerows] $rev]
4116     } else {
4117         set findstartline $selectedline
4118     }
4119     set findcurline $findstartline
4120     nowbusy finding
4121     if {!$rev} {
4122         run findmore
4123     } else {
4124         if {$findcurline == 0} {
4125             set findcurline $numcommits
4126         }
4127         incr findcurline -1
4128         run findmorerev
4129     }
4130 }
4131
4132 proc findnext {restart} {
4133     global findcurline
4134     if {![info exists findcurline]} {
4135         if {$restart} {
4136             dofind
4137         } else {
4138             bell
4139         }
4140     } else {
4141         run findmore
4142         nowbusy finding
4143     }
4144 }
4145
4146 proc findprev {} {
4147     global findcurline
4148     if {![info exists findcurline]} {
4149         dofind 1
4150     } else {
4151         run findmorerev
4152         nowbusy finding
4153     }
4154 }
4155
4156 proc findmore {} {
4157     global commitdata commitinfo numcommits findstring findpattern findloc
4158     global findstartline findcurline displayorder
4159
4160     set fldtypes {Headline Author Date Committer CDate Comments}
4161     set l [expr {$findcurline + 1}]
4162     if {$l >= $numcommits} {
4163         set l 0
4164     }
4165     if {$l <= $findstartline} {
4166         set lim [expr {$findstartline + 1}]
4167     } else {
4168         set lim $numcommits
4169     }
4170     if {$lim - $l > 500} {
4171         set lim [expr {$l + 500}]
4172     }
4173     set last 0
4174     for {} {$l < $lim} {incr l} {
4175         set id [lindex $displayorder $l]
4176         # shouldn't happen unless git log doesn't give all the commits...
4177         if {![info exists commitdata($id)]} continue
4178         if {![doesmatch $commitdata($id)]} continue
4179         if {![info exists commitinfo($id)]} {
4180             getcommit $id
4181         }
4182         set info $commitinfo($id)
4183         foreach f $info ty $fldtypes {
4184             if {($findloc eq "All fields" || $findloc eq $ty) &&
4185                 [doesmatch $f]} {
4186                 findselectline $l
4187                 notbusy finding
4188                 return 0
4189             }
4190         }
4191     }
4192     if {$l == $findstartline + 1} {
4193         bell
4194         unset findcurline
4195         notbusy finding
4196         return 0
4197     }
4198     set findcurline [expr {$l - 1}]
4199     return 1
4200 }
4201
4202 proc findmorerev {} {
4203     global commitdata commitinfo numcommits findstring findpattern findloc
4204     global findstartline findcurline displayorder
4205
4206     set fldtypes {Headline Author Date Committer CDate Comments}
4207     set l $findcurline
4208     if {$l == 0} {
4209         set l $numcommits
4210     }
4211     incr l -1
4212     if {$l >= $findstartline} {
4213         set lim [expr {$findstartline - 1}]
4214     } else {
4215         set lim -1
4216     }
4217     if {$l - $lim > 500} {
4218         set lim [expr {$l - 500}]
4219     }
4220     set last 0
4221     for {} {$l > $lim} {incr l -1} {
4222         set id [lindex $displayorder $l]
4223         if {![info exists commitdata($id)]} continue
4224         if {![doesmatch $commitdata($id)]} continue
4225         if {![info exists commitinfo($id)]} {
4226             getcommit $id
4227         }
4228         set info $commitinfo($id)
4229         foreach f $info ty $fldtypes {
4230             if {($findloc eq "All fields" || $findloc eq $ty) &&
4231                 [doesmatch $f]} {
4232                 findselectline $l
4233                 notbusy finding
4234                 return 0
4235             }
4236         }
4237     }
4238     if {$l == -1} {
4239         bell
4240         unset findcurline
4241         notbusy finding
4242         return 0
4243     }
4244     set findcurline [expr {$l + 1}]
4245     return 1
4246 }
4247
4248 proc findselectline {l} {
4249     global findloc commentend ctext findcurline markingmatches
4250
4251     set markingmatches 1
4252     set findcurline $l
4253     selectline $l 1
4254     if {$findloc == "All fields" || $findloc == "Comments"} {
4255         # highlight the matches in the comments
4256         set f [$ctext get 1.0 $commentend]
4257         set matches [findmatches $f]
4258         foreach match $matches {
4259             set start [lindex $match 0]
4260             set end [expr {[lindex $match 1] + 1}]
4261             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4262         }
4263     }
4264     drawvisible
4265 }
4266
4267 # mark the bits of a headline or author that match a find string
4268 proc markmatches {canv l str tag matches font row} {
4269     global selectedline
4270
4271     set bbox [$canv bbox $tag]
4272     set x0 [lindex $bbox 0]
4273     set y0 [lindex $bbox 1]
4274     set y1 [lindex $bbox 3]
4275     foreach match $matches {
4276         set start [lindex $match 0]
4277         set end [lindex $match 1]
4278         if {$start > $end} continue
4279         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4280         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4281         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4282                    [expr {$x0+$xlen+2}] $y1 \
4283                    -outline {} -tags [list match$l matches] -fill yellow]
4284         $canv lower $t
4285         if {[info exists selectedline] && $row == $selectedline} {
4286             $canv raise $t secsel
4287         }
4288     }
4289 }
4290
4291 proc unmarkmatches {} {
4292     global findids markingmatches findcurline
4293
4294     allcanvs delete matches
4295     catch {unset findids}
4296     set markingmatches 0
4297     catch {unset findcurline}
4298 }
4299
4300 proc selcanvline {w x y} {
4301     global canv canvy0 ctext linespc
4302     global rowtextx
4303     set ymax [lindex [$canv cget -scrollregion] 3]
4304     if {$ymax == {}} return
4305     set yfrac [lindex [$canv yview] 0]
4306     set y [expr {$y + $yfrac * $ymax}]
4307     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4308     if {$l < 0} {
4309         set l 0
4310     }
4311     if {$w eq $canv} {
4312         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4313     }
4314     unmarkmatches
4315     selectline $l 1
4316 }
4317
4318 proc commit_descriptor {p} {
4319     global commitinfo
4320     if {![info exists commitinfo($p)]} {
4321         getcommit $p
4322     }
4323     set l "..."
4324     if {[llength $commitinfo($p)] > 1} {
4325         set l [lindex $commitinfo($p) 0]
4326     }
4327     return "$p ($l)\n"
4328 }
4329
4330 # append some text to the ctext widget, and make any SHA1 ID
4331 # that we know about be a clickable link.
4332 proc appendwithlinks {text tags} {
4333     global ctext commitrow linknum curview pendinglinks
4334
4335     set start [$ctext index "end - 1c"]
4336     $ctext insert end $text $tags
4337     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4338     foreach l $links {
4339         set s [lindex $l 0]
4340         set e [lindex $l 1]
4341         set linkid [string range $text $s $e]
4342         incr e
4343         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4344         setlink $linkid link$linknum
4345         incr linknum
4346     }
4347 }
4348
4349 proc setlink {id lk} {
4350     global curview commitrow ctext pendinglinks commitinterest
4351
4352     if {[info exists commitrow($curview,$id)]} {
4353         $ctext tag conf $lk -foreground blue -underline 1
4354         $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4355         $ctext tag bind $lk <Enter> {linkcursor %W 1}
4356         $ctext tag bind $lk <Leave> {linkcursor %W -1}
4357     } else {
4358         lappend pendinglinks($id) $lk
4359         lappend commitinterest($id) {makelink %I}
4360     }
4361 }
4362
4363 proc makelink {id} {
4364     global pendinglinks
4365
4366     if {![info exists pendinglinks($id)]} return
4367     foreach lk $pendinglinks($id) {
4368         setlink $id $lk
4369     }
4370     unset pendinglinks($id)
4371 }
4372
4373 proc linkcursor {w inc} {
4374     global linkentercount curtextcursor
4375
4376     if {[incr linkentercount $inc] > 0} {
4377         $w configure -cursor hand2
4378     } else {
4379         $w configure -cursor $curtextcursor
4380         if {$linkentercount < 0} {
4381             set linkentercount 0
4382         }
4383     }
4384 }
4385
4386 proc viewnextline {dir} {
4387     global canv linespc
4388
4389     $canv delete hover
4390     set ymax [lindex [$canv cget -scrollregion] 3]
4391     set wnow [$canv yview]
4392     set wtop [expr {[lindex $wnow 0] * $ymax}]
4393     set newtop [expr {$wtop + $dir * $linespc}]
4394     if {$newtop < 0} {
4395         set newtop 0
4396     } elseif {$newtop > $ymax} {
4397         set newtop $ymax
4398     }
4399     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4400 }
4401
4402 # add a list of tag or branch names at position pos
4403 # returns the number of names inserted
4404 proc appendrefs {pos ids var} {
4405     global ctext commitrow linknum curview $var maxrefs
4406
4407     if {[catch {$ctext index $pos}]} {
4408         return 0
4409     }
4410     $ctext conf -state normal
4411     $ctext delete $pos "$pos lineend"
4412     set tags {}
4413     foreach id $ids {
4414         foreach tag [set $var\($id\)] {
4415             lappend tags [list $tag $id]
4416         }
4417     }
4418     if {[llength $tags] > $maxrefs} {
4419         $ctext insert $pos "many ([llength $tags])"
4420     } else {
4421         set tags [lsort -index 0 -decreasing $tags]
4422         set sep {}
4423         foreach ti $tags {
4424             set id [lindex $ti 1]
4425             set lk link$linknum
4426             incr linknum
4427             $ctext tag delete $lk
4428             $ctext insert $pos $sep
4429             $ctext insert $pos [lindex $ti 0] $lk
4430             setlink $id $lk
4431             set sep ", "
4432         }
4433     }
4434     $ctext conf -state disabled
4435     return [llength $tags]
4436 }
4437
4438 # called when we have finished computing the nearby tags
4439 proc dispneartags {delay} {
4440     global selectedline currentid showneartags tagphase
4441
4442     if {![info exists selectedline] || !$showneartags} return
4443     after cancel dispnexttag
4444     if {$delay} {
4445         after 200 dispnexttag
4446         set tagphase -1
4447     } else {
4448         after idle dispnexttag
4449         set tagphase 0
4450     }
4451 }
4452
4453 proc dispnexttag {} {
4454     global selectedline currentid showneartags tagphase ctext
4455
4456     if {![info exists selectedline] || !$showneartags} return
4457     switch -- $tagphase {
4458         0 {
4459             set dtags [desctags $currentid]
4460             if {$dtags ne {}} {
4461                 appendrefs precedes $dtags idtags
4462             }
4463         }
4464         1 {
4465             set atags [anctags $currentid]
4466             if {$atags ne {}} {
4467                 appendrefs follows $atags idtags
4468             }
4469         }
4470         2 {
4471             set dheads [descheads $currentid]
4472             if {$dheads ne {}} {
4473                 if {[appendrefs branch $dheads idheads] > 1
4474                     && [$ctext get "branch -3c"] eq "h"} {
4475                     # turn "Branch" into "Branches"
4476                     $ctext conf -state normal
4477                     $ctext insert "branch -2c" "es"
4478                     $ctext conf -state disabled
4479                 }
4480             }
4481         }
4482     }
4483     if {[incr tagphase] <= 2} {
4484         after idle dispnexttag
4485     }
4486 }
4487
4488 proc selectline {l isnew} {
4489     global canv canv2 canv3 ctext commitinfo selectedline
4490     global displayorder linehtag linentag linedtag
4491     global canvy0 linespc parentlist children curview
4492     global currentid sha1entry
4493     global commentend idtags linknum
4494     global mergemax numcommits pending_select
4495     global cmitmode showneartags allcommits
4496
4497     catch {unset pending_select}
4498     $canv delete hover
4499     normalline
4500     cancel_next_highlight
4501     unsel_reflist
4502     if {$l < 0 || $l >= $numcommits} return
4503     set y [expr {$canvy0 + $l * $linespc}]
4504     set ymax [lindex [$canv cget -scrollregion] 3]
4505     set ytop [expr {$y - $linespc - 1}]
4506     set ybot [expr {$y + $linespc + 1}]
4507     set wnow [$canv yview]
4508     set wtop [expr {[lindex $wnow 0] * $ymax}]
4509     set wbot [expr {[lindex $wnow 1] * $ymax}]
4510     set wh [expr {$wbot - $wtop}]
4511     set newtop $wtop
4512     if {$ytop < $wtop} {
4513         if {$ybot < $wtop} {
4514             set newtop [expr {$y - $wh / 2.0}]
4515         } else {
4516             set newtop $ytop
4517             if {$newtop > $wtop - $linespc} {
4518                 set newtop [expr {$wtop - $linespc}]
4519             }
4520         }
4521     } elseif {$ybot > $wbot} {
4522         if {$ytop > $wbot} {
4523             set newtop [expr {$y - $wh / 2.0}]
4524         } else {
4525             set newtop [expr {$ybot - $wh}]
4526             if {$newtop < $wtop + $linespc} {
4527                 set newtop [expr {$wtop + $linespc}]
4528             }
4529         }
4530     }
4531     if {$newtop != $wtop} {
4532         if {$newtop < 0} {
4533             set newtop 0
4534         }
4535         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4536         drawvisible
4537     }
4538
4539     if {![info exists linehtag($l)]} return
4540     $canv delete secsel
4541     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4542                -tags secsel -fill [$canv cget -selectbackground]]
4543     $canv lower $t
4544     $canv2 delete secsel
4545     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4546                -tags secsel -fill [$canv2 cget -selectbackground]]
4547     $canv2 lower $t
4548     $canv3 delete secsel
4549     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4550                -tags secsel -fill [$canv3 cget -selectbackground]]
4551     $canv3 lower $t
4552
4553     if {$isnew} {
4554         addtohistory [list selectline $l 0]
4555     }
4556
4557     set selectedline $l
4558
4559     set id [lindex $displayorder $l]
4560     set currentid $id
4561     $sha1entry delete 0 end
4562     $sha1entry insert 0 $id
4563     $sha1entry selection from 0
4564     $sha1entry selection to end
4565     rhighlight_sel $id
4566
4567     $ctext conf -state normal
4568     clear_ctext
4569     set linknum 0
4570     set info $commitinfo($id)
4571     set date [formatdate [lindex $info 2]]
4572     $ctext insert end "Author: [lindex $info 1]  $date\n"
4573     set date [formatdate [lindex $info 4]]
4574     $ctext insert end "Committer: [lindex $info 3]  $date\n"
4575     if {[info exists idtags($id)]} {
4576         $ctext insert end "Tags:"
4577         foreach tag $idtags($id) {
4578             $ctext insert end " $tag"
4579         }
4580         $ctext insert end "\n"
4581     }
4582
4583     set headers {}
4584     set olds [lindex $parentlist $l]
4585     if {[llength $olds] > 1} {
4586         set np 0
4587         foreach p $olds {
4588             if {$np >= $mergemax} {
4589                 set tag mmax
4590             } else {
4591                 set tag m$np
4592             }
4593             $ctext insert end "Parent: " $tag
4594             appendwithlinks [commit_descriptor $p] {}
4595             incr np
4596         }
4597     } else {
4598         foreach p $olds {
4599             append headers "Parent: [commit_descriptor $p]"
4600         }
4601     }
4602
4603     foreach c $children($curview,$id) {
4604         append headers "Child:  [commit_descriptor $c]"
4605     }
4606
4607     # make anything that looks like a SHA1 ID be a clickable link
4608     appendwithlinks $headers {}
4609     if {$showneartags} {
4610         if {![info exists allcommits]} {
4611             getallcommits
4612         }
4613         $ctext insert end "Branch: "
4614         $ctext mark set branch "end -1c"
4615         $ctext mark gravity branch left
4616         $ctext insert end "\nFollows: "
4617         $ctext mark set follows "end -1c"
4618         $ctext mark gravity follows left
4619         $ctext insert end "\nPrecedes: "
4620         $ctext mark set precedes "end -1c"
4621         $ctext mark gravity precedes left
4622         $ctext insert end "\n"
4623         dispneartags 1
4624     }
4625     $ctext insert end "\n"
4626     set comment [lindex $info 5]
4627     if {[string first "\r" $comment] >= 0} {
4628         set comment [string map {"\r" "\n    "} $comment]
4629     }
4630     appendwithlinks $comment {comment}
4631
4632     $ctext tag remove found 1.0 end
4633     $ctext conf -state disabled
4634     set commentend [$ctext index "end - 1c"]
4635
4636     init_flist "Comments"
4637     if {$cmitmode eq "tree"} {
4638         gettree $id
4639     } elseif {[llength $olds] <= 1} {
4640         startdiff $id
4641     } else {
4642         mergediff $id $l
4643     }
4644 }
4645
4646 proc selfirstline {} {
4647     unmarkmatches
4648     selectline 0 1
4649 }
4650
4651 proc sellastline {} {
4652     global numcommits
4653     unmarkmatches
4654     set l [expr {$numcommits - 1}]
4655     selectline $l 1
4656 }
4657
4658 proc selnextline {dir} {
4659     global selectedline
4660     focus .
4661     if {![info exists selectedline]} return
4662     set l [expr {$selectedline + $dir}]
4663     unmarkmatches
4664     selectline $l 1
4665 }
4666
4667 proc selnextpage {dir} {
4668     global canv linespc selectedline numcommits
4669
4670     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4671     if {$lpp < 1} {
4672         set lpp 1
4673     }
4674     allcanvs yview scroll [expr {$dir * $lpp}] units
4675     drawvisible
4676     if {![info exists selectedline]} return
4677     set l [expr {$selectedline + $dir * $lpp}]
4678     if {$l < 0} {
4679         set l 0
4680     } elseif {$l >= $numcommits} {
4681         set l [expr $numcommits - 1]
4682     }
4683     unmarkmatches
4684     selectline $l 1
4685 }
4686
4687 proc unselectline {} {
4688     global selectedline currentid
4689
4690     catch {unset selectedline}
4691     catch {unset currentid}
4692     allcanvs delete secsel
4693     rhighlight_none
4694     cancel_next_highlight
4695 }
4696
4697 proc reselectline {} {
4698     global selectedline
4699
4700     if {[info exists selectedline]} {
4701         selectline $selectedline 0
4702     }
4703 }
4704
4705 proc addtohistory {cmd} {
4706     global history historyindex curview
4707
4708     set elt [list $curview $cmd]
4709     if {$historyindex > 0
4710         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4711         return
4712     }
4713
4714     if {$historyindex < [llength $history]} {
4715         set history [lreplace $history $historyindex end $elt]
4716     } else {
4717         lappend history $elt
4718     }
4719     incr historyindex
4720     if {$historyindex > 1} {
4721         .tf.bar.leftbut conf -state normal
4722     } else {
4723         .tf.bar.leftbut conf -state disabled
4724     }
4725     .tf.bar.rightbut conf -state disabled
4726 }
4727
4728 proc godo {elt} {
4729     global curview
4730
4731     set view [lindex $elt 0]
4732     set cmd [lindex $elt 1]
4733     if {$curview != $view} {
4734         showview $view
4735     }
4736     eval $cmd
4737 }
4738
4739 proc goback {} {
4740     global history historyindex
4741     focus .
4742
4743     if {$historyindex > 1} {
4744         incr historyindex -1
4745         godo [lindex $history [expr {$historyindex - 1}]]
4746         .tf.bar.rightbut conf -state normal
4747     }
4748     if {$historyindex <= 1} {
4749         .tf.bar.leftbut conf -state disabled
4750     }
4751 }
4752
4753 proc goforw {} {
4754     global history historyindex
4755     focus .
4756
4757     if {$historyindex < [llength $history]} {
4758         set cmd [lindex $history $historyindex]
4759         incr historyindex
4760         godo $cmd
4761         .tf.bar.leftbut conf -state normal
4762     }
4763     if {$historyindex >= [llength $history]} {
4764         .tf.bar.rightbut conf -state disabled
4765     }
4766 }
4767
4768 proc gettree {id} {
4769     global treefilelist treeidlist diffids diffmergeid treepending
4770     global nullid nullid2
4771
4772     set diffids $id
4773     catch {unset diffmergeid}
4774     if {![info exists treefilelist($id)]} {
4775         if {![info exists treepending]} {
4776             if {$id eq $nullid} {
4777                 set cmd [list | git ls-files]
4778             } elseif {$id eq $nullid2} {
4779                 set cmd [list | git ls-files --stage -t]
4780             } else {
4781                 set cmd [list | git ls-tree -r $id]
4782             }
4783             if {[catch {set gtf [open $cmd r]}]} {
4784                 return
4785             }
4786             set treepending $id
4787             set treefilelist($id) {}
4788             set treeidlist($id) {}
4789             fconfigure $gtf -blocking 0
4790             filerun $gtf [list gettreeline $gtf $id]
4791         }
4792     } else {
4793         setfilelist $id
4794     }
4795 }
4796
4797 proc gettreeline {gtf id} {
4798     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4799
4800     set nl 0
4801     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4802         if {$diffids eq $nullid} {
4803             set fname $line
4804         } else {
4805             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4806             set i [string first "\t" $line]
4807             if {$i < 0} continue
4808             set sha1 [lindex $line 2]
4809             set fname [string range $line [expr {$i+1}] end]
4810             if {[string index $fname 0] eq "\""} {
4811                 set fname [lindex $fname 0]
4812             }
4813             lappend treeidlist($id) $sha1
4814         }
4815         lappend treefilelist($id) $fname
4816     }
4817     if {![eof $gtf]} {
4818         return [expr {$nl >= 1000? 2: 1}]
4819     }
4820     close $gtf
4821     unset treepending
4822     if {$cmitmode ne "tree"} {
4823         if {![info exists diffmergeid]} {
4824             gettreediffs $diffids
4825         }
4826     } elseif {$id ne $diffids} {
4827         gettree $diffids
4828     } else {
4829         setfilelist $id
4830     }
4831     return 0
4832 }
4833
4834 proc showfile {f} {
4835     global treefilelist treeidlist diffids nullid nullid2
4836     global ctext commentend
4837
4838     set i [lsearch -exact $treefilelist($diffids) $f]
4839     if {$i < 0} {
4840         puts "oops, $f not in list for id $diffids"
4841         return
4842     }
4843     if {$diffids eq $nullid} {
4844         if {[catch {set bf [open $f r]} err]} {
4845             puts "oops, can't read $f: $err"
4846             return
4847         }
4848     } else {
4849         set blob [lindex $treeidlist($diffids) $i]
4850         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4851             puts "oops, error reading blob $blob: $err"
4852             return
4853         }
4854     }
4855     fconfigure $bf -blocking 0
4856     filerun $bf [list getblobline $bf $diffids]
4857     $ctext config -state normal
4858     clear_ctext $commentend
4859     $ctext insert end "\n"
4860     $ctext insert end "$f\n" filesep
4861     $ctext config -state disabled
4862     $ctext yview $commentend
4863 }
4864
4865 proc getblobline {bf id} {
4866     global diffids cmitmode ctext
4867
4868     if {$id ne $diffids || $cmitmode ne "tree"} {
4869         catch {close $bf}
4870         return 0
4871     }
4872     $ctext config -state normal
4873     set nl 0
4874     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4875         $ctext insert end "$line\n"
4876     }
4877     if {[eof $bf]} {
4878         # delete last newline
4879         $ctext delete "end - 2c" "end - 1c"
4880         close $bf
4881         return 0
4882     }
4883     $ctext config -state disabled
4884     return [expr {$nl >= 1000? 2: 1}]
4885 }
4886
4887 proc mergediff {id l} {
4888     global diffmergeid diffopts mdifffd
4889     global diffids
4890     global parentlist
4891
4892     set diffmergeid $id
4893     set diffids $id
4894     # this doesn't seem to actually affect anything...
4895     set env(GIT_DIFF_OPTS) $diffopts
4896     set cmd [concat | git diff-tree --no-commit-id --cc $id]
4897     if {[catch {set mdf [open $cmd r]} err]} {
4898         error_popup "Error getting merge diffs: $err"
4899         return
4900     }
4901     fconfigure $mdf -blocking 0
4902     set mdifffd($id) $mdf
4903     set np [llength [lindex $parentlist $l]]
4904     filerun $mdf [list getmergediffline $mdf $id $np]
4905 }
4906
4907 proc getmergediffline {mdf id np} {
4908     global diffmergeid ctext cflist mergemax
4909     global difffilestart mdifffd
4910
4911     $ctext conf -state normal
4912     set nr 0
4913     while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4914         if {![info exists diffmergeid] || $id != $diffmergeid
4915             || $mdf != $mdifffd($id)} {
4916             close $mdf
4917             return 0
4918         }
4919         if {[regexp {^diff --cc (.*)} $line match fname]} {
4920             # start of a new file
4921             $ctext insert end "\n"
4922             set here [$ctext index "end - 1c"]
4923             lappend difffilestart $here
4924             add_flist [list $fname]
4925             set l [expr {(78 - [string length $fname]) / 2}]
4926             set pad [string range "----------------------------------------" 1 $l]
4927             $ctext insert end "$pad $fname $pad\n" filesep
4928         } elseif {[regexp {^@@} $line]} {
4929             $ctext insert end "$line\n" hunksep
4930         } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4931             # do nothing
4932         } else {
4933             # parse the prefix - one ' ', '-' or '+' for each parent
4934             set spaces {}
4935             set minuses {}
4936             set pluses {}
4937             set isbad 0
4938             for {set j 0} {$j < $np} {incr j} {
4939                 set c [string range $line $j $j]
4940                 if {$c == " "} {
4941                     lappend spaces $j
4942                 } elseif {$c == "-"} {
4943                     lappend minuses $j
4944                 } elseif {$c == "+"} {
4945                     lappend pluses $j
4946                 } else {
4947                     set isbad 1
4948                     break
4949                 }
4950             }
4951             set tags {}
4952             set num {}
4953             if {!$isbad && $minuses ne {} && $pluses eq {}} {
4954                 # line doesn't appear in result, parents in $minuses have the line
4955                 set num [lindex $minuses 0]
4956             } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4957                 # line appears in result, parents in $pluses don't have the line
4958                 lappend tags mresult
4959                 set num [lindex $spaces 0]
4960             }
4961             if {$num ne {}} {
4962                 if {$num >= $mergemax} {
4963                     set num "max"
4964                 }
4965                 lappend tags m$num
4966             }
4967             $ctext insert end "$line\n" $tags
4968         }
4969     }
4970     $ctext conf -state disabled
4971     if {[eof $mdf]} {
4972         close $mdf
4973         return 0
4974     }
4975     return [expr {$nr >= 1000? 2: 1}]
4976 }
4977
4978 proc startdiff {ids} {
4979     global treediffs diffids treepending diffmergeid nullid nullid2
4980
4981     set diffids $ids
4982     catch {unset diffmergeid}
4983     if {![info exists treediffs($ids)] ||
4984         [lsearch -exact $ids $nullid] >= 0 ||
4985         [lsearch -exact $ids $nullid2] >= 0} {
4986         if {![info exists treepending]} {
4987             gettreediffs $ids
4988         }
4989     } else {
4990         addtocflist $ids
4991     }
4992 }
4993
4994 proc addtocflist {ids} {
4995     global treediffs cflist
4996     add_flist $treediffs($ids)
4997     getblobdiffs $ids
4998 }
4999
5000 proc diffcmd {ids flags} {
5001     global nullid nullid2
5002
5003     set i [lsearch -exact $ids $nullid]
5004     set j [lsearch -exact $ids $nullid2]
5005     if {$i >= 0} {
5006         if {[llength $ids] > 1 && $j < 0} {
5007             # comparing working directory with some specific revision
5008             set cmd [concat | git diff-index $flags]
5009             if {$i == 0} {
5010                 lappend cmd -R [lindex $ids 1]
5011             } else {
5012                 lappend cmd [lindex $ids 0]
5013             }
5014         } else {
5015             # comparing working directory with index
5016             set cmd [concat | git diff-files $flags]
5017             if {$j == 1} {
5018                 lappend cmd -R
5019             }
5020         }
5021     } elseif {$j >= 0} {
5022         set cmd [concat | git diff-index --cached $flags]
5023         if {[llength $ids] > 1} {
5024             # comparing index with specific revision
5025             if {$i == 0} {
5026                 lappend cmd -R [lindex $ids 1]
5027             } else {
5028                 lappend cmd [lindex $ids 0]
5029             }
5030         } else {
5031             # comparing index with HEAD
5032             lappend cmd HEAD
5033         }
5034     } else {
5035         set cmd [concat | git diff-tree -r $flags $ids]
5036     }
5037     return $cmd
5038 }
5039
5040 proc gettreediffs {ids} {
5041     global treediff treepending
5042
5043     set treepending $ids
5044     set treediff {}
5045     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5046     fconfigure $gdtf -blocking 0
5047     filerun $gdtf [list gettreediffline $gdtf $ids]
5048 }
5049
5050 proc gettreediffline {gdtf ids} {
5051     global treediff treediffs treepending diffids diffmergeid
5052     global cmitmode
5053
5054     set nr 0
5055     while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5056         set i [string first "\t" $line]
5057         if {$i >= 0} {
5058             set file [string range $line [expr {$i+1}] end]
5059             if {[string index $file 0] eq "\""} {
5060                 set file [lindex $file 0]
5061             }
5062             lappend treediff $file
5063         }
5064     }
5065     if {![eof $gdtf]} {
5066         return [expr {$nr >= 1000? 2: 1}]
5067     }
5068     close $gdtf
5069     set treediffs($ids) $treediff
5070     unset treepending
5071     if {$cmitmode eq "tree"} {
5072         gettree $diffids
5073     } elseif {$ids != $diffids} {
5074         if {![info exists diffmergeid]} {
5075             gettreediffs $diffids
5076         }
5077     } else {
5078         addtocflist $ids
5079     }
5080     return 0
5081 }
5082
5083 # empty string or positive integer
5084 proc diffcontextvalidate {v} {
5085     return [regexp {^(|[1-9][0-9]*)$} $v]
5086 }
5087
5088 proc diffcontextchange {n1 n2 op} {
5089     global diffcontextstring diffcontext
5090
5091     if {[string is integer -strict $diffcontextstring]} {
5092         if {$diffcontextstring > 0} {
5093             set diffcontext $diffcontextstring
5094             reselectline
5095         }
5096     }
5097 }
5098
5099 proc getblobdiffs {ids} {
5100     global diffopts blobdifffd diffids env
5101     global diffinhdr treediffs
5102     global diffcontext
5103
5104     set env(GIT_DIFF_OPTS) $diffopts
5105     if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5106         puts "error getting diffs: $err"
5107         return
5108     }
5109     set diffinhdr 0
5110     fconfigure $bdf -blocking 0
5111     set blobdifffd($ids) $bdf
5112     filerun $bdf [list getblobdiffline $bdf $diffids]
5113 }
5114
5115 proc setinlist {var i val} {
5116     global $var
5117
5118     while {[llength [set $var]] < $i} {
5119         lappend $var {}
5120     }
5121     if {[llength [set $var]] == $i} {
5122         lappend $var $val
5123     } else {
5124         lset $var $i $val
5125     }
5126 }
5127
5128 proc makediffhdr {fname ids} {
5129     global ctext curdiffstart treediffs
5130
5131     set i [lsearch -exact $treediffs($ids) $fname]
5132     if {$i >= 0} {
5133         setinlist difffilestart $i $curdiffstart
5134     }
5135     set l [expr {(78 - [string length $fname]) / 2}]
5136     set pad [string range "----------------------------------------" 1 $l]
5137     $ctext insert $curdiffstart "$pad $fname $pad" filesep
5138 }
5139
5140 proc getblobdiffline {bdf ids} {
5141     global diffids blobdifffd ctext curdiffstart
5142     global diffnexthead diffnextnote difffilestart
5143     global diffinhdr treediffs
5144
5145     set nr 0
5146     $ctext conf -state normal
5147     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5148         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5149             close $bdf
5150             return 0
5151         }
5152         if {![string compare -length 11 "diff --git " $line]} {
5153             # trim off "diff --git "
5154             set line [string range $line 11 end]
5155             set diffinhdr 1
5156             # start of a new file
5157             $ctext insert end "\n"
5158             set curdiffstart [$ctext index "end - 1c"]
5159             $ctext insert end "\n" filesep
5160             # If the name hasn't changed the length will be odd,
5161             # the middle char will be a space, and the two bits either
5162             # side will be a/name and b/name, or "a/name" and "b/name".
5163             # If the name has changed we'll get "rename from" and
5164             # "rename to" or "copy from" and "copy to" lines following this,
5165             # and we'll use them to get the filenames.
5166             # This complexity is necessary because spaces in the filename(s)
5167             # don't get escaped.
5168             set l [string length $line]
5169             set i [expr {$l / 2}]
5170             if {!(($l & 1) && [string index $line $i] eq " " &&
5171                   [string range $line 2 [expr {$i - 1}]] eq \
5172                       [string range $line [expr {$i + 3}] end])} {
5173                 continue
5174             }
5175             # unescape if quoted and chop off the a/ from the front
5176             if {[string index $line 0] eq "\""} {
5177                 set fname [string range [lindex $line 0] 2 end]
5178             } else {
5179                 set fname [string range $line 2 [expr {$i - 1}]]
5180             }
5181             makediffhdr $fname $ids
5182
5183         } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5184                        $line match f1l f1c f2l f2c rest]} {
5185             $ctext insert end "$line\n" hunksep
5186             set diffinhdr 0
5187
5188         } elseif {$diffinhdr} {
5189             if {![string compare -length 12 "rename from " $line] ||
5190                 ![string compare -length 10 "copy from " $line]} {
5191                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5192                 if {[string index $fname 0] eq "\""} {
5193                     set fname [lindex $fname 0]
5194                 }
5195                 set i [lsearch -exact $treediffs($ids) $fname]
5196                 if {$i >= 0} {
5197                     setinlist difffilestart $i $curdiffstart
5198                 }
5199             } elseif {![string compare -length 10 $line "rename to "] ||
5200                       ![string compare -length 8 $line "copy to "]} {
5201                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5202                 if {[string index $fname 0] eq "\""} {
5203                     set fname [lindex $fname 0]
5204                 }
5205                 makediffhdr $fname $ids
5206             } elseif {[string compare -length 3 $line "---"] == 0} {
5207                 # do nothing
5208                 continue
5209             } elseif {[string compare -length 3 $line "+++"] == 0} {
5210                 set diffinhdr 0
5211                 continue
5212             }
5213             $ctext insert end "$line\n" filesep
5214
5215         } else {
5216             set x [string range $line 0 0]
5217             if {$x == "-" || $x == "+"} {
5218                 set tag [expr {$x == "+"}]
5219                 $ctext insert end "$line\n" d$tag
5220             } elseif {$x == " "} {
5221                 $ctext insert end "$line\n"
5222             } else {
5223                 # "\ No newline at end of file",
5224                 # or something else we don't recognize
5225                 $ctext insert end "$line\n" hunksep
5226             }
5227         }
5228     }
5229     $ctext conf -state disabled
5230     if {[eof $bdf]} {
5231         close $bdf
5232         return 0
5233     }
5234     return [expr {$nr >= 1000? 2: 1}]
5235 }
5236
5237 proc changediffdisp {} {
5238     global ctext diffelide
5239
5240     $ctext tag conf d0 -elide [lindex $diffelide 0]
5241     $ctext tag conf d1 -elide [lindex $diffelide 1]
5242 }
5243
5244 proc prevfile {} {
5245     global difffilestart ctext
5246     set prev [lindex $difffilestart 0]
5247     set here [$ctext index @0,0]
5248     foreach loc $difffilestart {
5249         if {[$ctext compare $loc >= $here]} {
5250             $ctext yview $prev
5251             return
5252         }
5253         set prev $loc
5254     }
5255     $ctext yview $prev
5256 }
5257
5258 proc nextfile {} {
5259     global difffilestart ctext
5260     set here [$ctext index @0,0]
5261     foreach loc $difffilestart {
5262         if {[$ctext compare $loc > $here]} {
5263             $ctext yview $loc
5264             return
5265         }
5266     }
5267 }
5268
5269 proc clear_ctext {{first 1.0}} {
5270     global ctext smarktop smarkbot
5271     global pendinglinks
5272
5273     set l [lindex [split $first .] 0]
5274     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5275         set smarktop $l
5276     }
5277     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5278         set smarkbot $l
5279     }
5280     $ctext delete $first end
5281     if {$first eq "1.0"} {
5282         catch {unset pendinglinks}
5283     }
5284 }
5285
5286 proc incrsearch {name ix op} {
5287     global ctext searchstring searchdirn
5288
5289     $ctext tag remove found 1.0 end
5290     if {[catch {$ctext index anchor}]} {
5291         # no anchor set, use start of selection, or of visible area
5292         set sel [$ctext tag ranges sel]
5293         if {$sel ne {}} {
5294             $ctext mark set anchor [lindex $sel 0]
5295         } elseif {$searchdirn eq "-forwards"} {
5296             $ctext mark set anchor @0,0
5297         } else {
5298             $ctext mark set anchor @0,[winfo height $ctext]
5299         }
5300     }
5301     if {$searchstring ne {}} {
5302         set here [$ctext search $searchdirn -- $searchstring anchor]
5303         if {$here ne {}} {
5304             $ctext see $here
5305         }
5306         searchmarkvisible 1
5307     }
5308 }
5309
5310 proc dosearch {} {
5311     global sstring ctext searchstring searchdirn
5312
5313     focus $sstring
5314     $sstring icursor end
5315     set searchdirn -forwards
5316     if {$searchstring ne {}} {
5317         set sel [$ctext tag ranges sel]
5318         if {$sel ne {}} {
5319             set start "[lindex $sel 0] + 1c"
5320         } elseif {[catch {set start [$ctext index anchor]}]} {
5321             set start "@0,0"
5322         }
5323         set match [$ctext search -count mlen -- $searchstring $start]
5324         $ctext tag remove sel 1.0 end
5325         if {$match eq {}} {
5326             bell
5327             return
5328         }
5329         $ctext see $match
5330         set mend "$match + $mlen c"
5331         $ctext tag add sel $match $mend
5332         $ctext mark unset anchor
5333     }
5334 }
5335
5336 proc dosearchback {} {
5337     global sstring ctext searchstring searchdirn
5338
5339     focus $sstring
5340     $sstring icursor end
5341     set searchdirn -backwards
5342     if {$searchstring ne {}} {
5343         set sel [$ctext tag ranges sel]
5344         if {$sel ne {}} {
5345             set start [lindex $sel 0]
5346         } elseif {[catch {set start [$ctext index anchor]}]} {
5347             set start @0,[winfo height $ctext]
5348         }
5349         set match [$ctext search -backwards -count ml -- $searchstring $start]
5350         $ctext tag remove sel 1.0 end
5351         if {$match eq {}} {
5352             bell
5353             return
5354         }
5355         $ctext see $match
5356         set mend "$match + $ml c"
5357         $ctext tag add sel $match $mend
5358         $ctext mark unset anchor
5359     }
5360 }
5361
5362 proc searchmark {first last} {
5363     global ctext searchstring
5364
5365     set mend $first.0
5366     while {1} {
5367         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5368         if {$match eq {}} break
5369         set mend "$match + $mlen c"
5370         $ctext tag add found $match $mend
5371     }
5372 }
5373
5374 proc searchmarkvisible {doall} {
5375     global ctext smarktop smarkbot
5376
5377     set topline [lindex [split [$ctext index @0,0] .] 0]
5378     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5379     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5380         # no overlap with previous
5381         searchmark $topline $botline
5382         set smarktop $topline
5383         set smarkbot $botline
5384     } else {
5385         if {$topline < $smarktop} {
5386             searchmark $topline [expr {$smarktop-1}]
5387             set smarktop $topline
5388         }
5389         if {$botline > $smarkbot} {
5390             searchmark [expr {$smarkbot+1}] $botline
5391             set smarkbot $botline
5392         }
5393     }
5394 }
5395
5396 proc scrolltext {f0 f1} {
5397     global searchstring
5398
5399     .bleft.sb set $f0 $f1
5400     if {$searchstring ne {}} {
5401         searchmarkvisible 0
5402     }
5403 }
5404
5405 proc setcoords {} {
5406     global linespc charspc canvx0 canvy0 mainfont
5407     global xspc1 xspc2 lthickness
5408
5409     set linespc [font metrics $mainfont -linespace]
5410     set charspc [font measure $mainfont "m"]
5411     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5412     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5413     set lthickness [expr {int($linespc / 9) + 1}]
5414     set xspc1(0) $linespc
5415     set xspc2 $linespc
5416 }
5417
5418 proc redisplay {} {
5419     global canv
5420     global selectedline
5421
5422     set ymax [lindex [$canv cget -scrollregion] 3]
5423     if {$ymax eq {} || $ymax == 0} return
5424     set span [$canv yview]
5425     clear_display
5426     setcanvscroll
5427     allcanvs yview moveto [lindex $span 0]
5428     drawvisible
5429     if {[info exists selectedline]} {
5430         selectline $selectedline 0
5431         allcanvs yview moveto [lindex $span 0]
5432     }
5433 }
5434
5435 proc incrfont {inc} {
5436     global mainfont textfont ctext canv phase cflist showrefstop
5437     global charspc tabstop
5438     global stopped entries
5439     unmarkmatches
5440     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5441     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5442     setcoords
5443     $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5444     $cflist conf -font $textfont
5445     $ctext tag conf filesep -font [concat $textfont bold]
5446     foreach e $entries {
5447         $e conf -font $mainfont
5448     }
5449     if {$phase eq "getcommits"} {
5450         $canv itemconf textitems -font $mainfont
5451     }
5452     if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5453         $showrefstop.list conf -font $mainfont
5454     }
5455     redisplay
5456 }
5457
5458 proc clearsha1 {} {
5459     global sha1entry sha1string
5460     if {[string length $sha1string] == 40} {
5461         $sha1entry delete 0 end
5462     }
5463 }
5464
5465 proc sha1change {n1 n2 op} {
5466     global sha1string currentid sha1but
5467     if {$sha1string == {}
5468         || ([info exists currentid] && $sha1string == $currentid)} {
5469         set state disabled
5470     } else {
5471         set state normal
5472     }
5473     if {[$sha1but cget -state] == $state} return
5474     if {$state == "normal"} {
5475         $sha1but conf -state normal -relief raised -text "Goto: "
5476     } else {
5477         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5478     }
5479 }
5480
5481 proc gotocommit {} {
5482     global sha1string currentid commitrow tagids headids
5483     global displayorder numcommits curview
5484
5485     if {$sha1string == {}
5486         || ([info exists currentid] && $sha1string == $currentid)} return
5487     if {[info exists tagids($sha1string)]} {
5488         set id $tagids($sha1string)
5489     } elseif {[info exists headids($sha1string)]} {
5490         set id $headids($sha1string)
5491     } else {
5492         set id [string tolower $sha1string]
5493         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5494             set matches {}
5495             foreach i $displayorder {
5496                 if {[string match $id* $i]} {
5497                     lappend matches $i
5498                 }
5499             }
5500             if {$matches ne {}} {
5501                 if {[llength $matches] > 1} {
5502                     error_popup "Short SHA1 id $id is ambiguous"
5503                     return
5504                 }
5505                 set id [lindex $matches 0]
5506             }
5507         }
5508     }
5509     if {[info exists commitrow($curview,$id)]} {
5510         selectline $commitrow($curview,$id) 1
5511         return
5512     }
5513     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5514         set type "SHA1 id"
5515     } else {
5516         set type "Tag/Head"
5517     }
5518     error_popup "$type $sha1string is not known"
5519 }
5520
5521 proc lineenter {x y id} {
5522     global hoverx hovery hoverid hovertimer
5523     global commitinfo canv
5524
5525     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5526     set hoverx $x
5527     set hovery $y
5528     set hoverid $id
5529     if {[info exists hovertimer]} {
5530         after cancel $hovertimer
5531     }
5532     set hovertimer [after 500 linehover]
5533     $canv delete hover
5534 }
5535
5536 proc linemotion {x y id} {
5537     global hoverx hovery hoverid hovertimer
5538
5539     if {[info exists hoverid] && $id == $hoverid} {
5540         set hoverx $x
5541         set hovery $y
5542         if {[info exists hovertimer]} {
5543             after cancel $hovertimer
5544         }
5545         set hovertimer [after 500 linehover]
5546     }
5547 }
5548
5549 proc lineleave {id} {
5550     global hoverid hovertimer canv
5551
5552     if {[info exists hoverid] && $id == $hoverid} {
5553         $canv delete hover
5554         if {[info exists hovertimer]} {
5555             after cancel $hovertimer
5556             unset hovertimer
5557         }
5558         unset hoverid
5559     }
5560 }
5561
5562 proc linehover {} {
5563     global hoverx hovery hoverid hovertimer
5564     global canv linespc lthickness
5565     global commitinfo mainfont
5566
5567     set text [lindex $commitinfo($hoverid) 0]
5568     set ymax [lindex [$canv cget -scrollregion] 3]
5569     if {$ymax == {}} return
5570     set yfrac [lindex [$canv yview] 0]
5571     set x [expr {$hoverx + 2 * $linespc}]
5572     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5573     set x0 [expr {$x - 2 * $lthickness}]
5574     set y0 [expr {$y - 2 * $lthickness}]
5575     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5576     set y1 [expr {$y + $linespc + 2 * $lthickness}]
5577     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5578                -fill \#ffff80 -outline black -width 1 -tags hover]
5579     $canv raise $t
5580     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5581                -font $mainfont]
5582     $canv raise $t
5583 }
5584
5585 proc clickisonarrow {id y} {
5586     global lthickness
5587
5588     set ranges [rowranges $id]
5589     set thresh [expr {2 * $lthickness + 6}]
5590     set n [expr {[llength $ranges] - 1}]
5591     for {set i 1} {$i < $n} {incr i} {
5592         set row [lindex $ranges $i]
5593         if {abs([yc $row] - $y) < $thresh} {
5594             return $i
5595         }
5596     }
5597     return {}
5598 }
5599
5600 proc arrowjump {id n y} {
5601     global canv
5602
5603     # 1 <-> 2, 3 <-> 4, etc...
5604     set n [expr {(($n - 1) ^ 1) + 1}]
5605     set row [lindex [rowranges $id] $n]
5606     set yt [yc $row]
5607     set ymax [lindex [$canv cget -scrollregion] 3]
5608     if {$ymax eq {} || $ymax <= 0} return
5609     set view [$canv yview]
5610     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5611     set yfrac [expr {$yt / $ymax - $yspan / 2}]
5612     if {$yfrac < 0} {
5613         set yfrac 0
5614     }
5615     allcanvs yview moveto $yfrac
5616 }
5617
5618 proc lineclick {x y id isnew} {
5619     global ctext commitinfo children canv thickerline curview
5620
5621     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5622     unmarkmatches
5623     unselectline
5624     normalline
5625     $canv delete hover
5626     # draw this line thicker than normal
5627     set thickerline $id
5628     drawlines $id
5629     if {$isnew} {
5630         set ymax [lindex [$canv cget -scrollregion] 3]
5631         if {$ymax eq {}} return
5632         set yfrac [lindex [$canv yview] 0]
5633         set y [expr {$y + $yfrac * $ymax}]
5634     }
5635     set dirn [clickisonarrow $id $y]
5636     if {$dirn ne {}} {
5637         arrowjump $id $dirn $y
5638         return
5639     }
5640
5641     if {$isnew} {
5642         addtohistory [list lineclick $x $y $id 0]
5643     }
5644     # fill the details pane with info about this line
5645     $ctext conf -state normal
5646     clear_ctext
5647     $ctext insert end "Parent:\t"
5648     $ctext insert end $id link0
5649     setlink $id link0
5650     set info $commitinfo($id)
5651     $ctext insert end "\n\t[lindex $info 0]\n"
5652     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5653     set date [formatdate [lindex $info 2]]
5654     $ctext insert end "\tDate:\t$date\n"
5655     set kids $children($curview,$id)
5656     if {$kids ne {}} {
5657         $ctext insert end "\nChildren:"
5658         set i 0
5659         foreach child $kids {
5660             incr i
5661             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5662             set info $commitinfo($child)
5663             $ctext insert end "\n\t"
5664             $ctext insert end $child link$i
5665             setlink $child link$i
5666             $ctext insert end "\n\t[lindex $info 0]"
5667             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5668             set date [formatdate [lindex $info 2]]
5669             $ctext insert end "\n\tDate:\t$date\n"
5670         }
5671     }
5672     $ctext conf -state disabled
5673     init_flist {}
5674 }
5675
5676 proc normalline {} {
5677     global thickerline
5678     if {[info exists thickerline]} {
5679         set id $thickerline
5680         unset thickerline
5681         drawlines $id
5682     }
5683 }
5684
5685 proc selbyid {id} {
5686     global commitrow curview
5687     if {[info exists commitrow($curview,$id)]} {
5688         selectline $commitrow($curview,$id) 1
5689     }
5690 }
5691
5692 proc mstime {} {
5693     global startmstime
5694     if {![info exists startmstime]} {
5695         set startmstime [clock clicks -milliseconds]
5696     }
5697     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5698 }
5699
5700 proc rowmenu {x y id} {
5701     global rowctxmenu commitrow selectedline rowmenuid curview
5702     global nullid nullid2 fakerowmenu mainhead
5703
5704     set rowmenuid $id
5705     if {![info exists selectedline]
5706         || $commitrow($curview,$id) eq $selectedline} {
5707         set state disabled
5708     } else {
5709         set state normal
5710     }
5711     if {$id ne $nullid && $id ne $nullid2} {
5712         set menu $rowctxmenu
5713         $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5714     } else {
5715         set menu $fakerowmenu
5716     }
5717     $menu entryconfigure "Diff this*" -state $state
5718     $menu entryconfigure "Diff selected*" -state $state
5719     $menu entryconfigure "Make patch" -state $state
5720     tk_popup $menu $x $y
5721 }
5722
5723 proc diffvssel {dirn} {
5724     global rowmenuid selectedline displayorder
5725
5726     if {![info exists selectedline]} return
5727     if {$dirn} {
5728         set oldid [lindex $displayorder $selectedline]
5729         set newid $rowmenuid
5730     } else {
5731         set oldid $rowmenuid
5732         set newid [lindex $displayorder $selectedline]
5733     }
5734     addtohistory [list doseldiff $oldid $newid]
5735     doseldiff $oldid $newid
5736 }
5737
5738 proc doseldiff {oldid newid} {
5739     global ctext
5740     global commitinfo
5741
5742     $ctext conf -state normal
5743     clear_ctext
5744     init_flist "Top"
5745     $ctext insert end "From "
5746     $ctext insert end $oldid link0
5747     setlink $oldid link0
5748     $ctext insert end "\n     "
5749     $ctext insert end [lindex $commitinfo($oldid) 0]
5750     $ctext insert end "\n\nTo   "
5751     $ctext insert end $newid link1
5752     setlink $newid link1
5753     $ctext insert end "\n     "
5754     $ctext insert end [lindex $commitinfo($newid) 0]
5755     $ctext insert end "\n"
5756     $ctext conf -state disabled
5757     $ctext tag remove found 1.0 end
5758     startdiff [list $oldid $newid]
5759 }
5760
5761 proc mkpatch {} {
5762     global rowmenuid currentid commitinfo patchtop patchnum
5763
5764     if {![info exists currentid]} return
5765     set oldid $currentid
5766     set oldhead [lindex $commitinfo($oldid) 0]
5767     set newid $rowmenuid
5768     set newhead [lindex $commitinfo($newid) 0]
5769     set top .patch
5770     set patchtop $top
5771     catch {destroy $top}
5772     toplevel $top
5773     label $top.title -text "Generate patch"
5774     grid $top.title - -pady 10
5775     label $top.from -text "From:"
5776     entry $top.fromsha1 -width 40 -relief flat
5777     $top.fromsha1 insert 0 $oldid
5778     $top.fromsha1 conf -state readonly
5779     grid $top.from $top.fromsha1 -sticky w
5780     entry $top.fromhead -width 60 -relief flat
5781     $top.fromhead insert 0 $oldhead
5782     $top.fromhead conf -state readonly
5783     grid x $top.fromhead -sticky w
5784     label $top.to -text "To:"
5785     entry $top.tosha1 -width 40 -relief flat
5786     $top.tosha1 insert 0 $newid
5787     $top.tosha1 conf -state readonly
5788     grid $top.to $top.tosha1 -sticky w
5789     entry $top.tohead -width 60 -relief flat
5790     $top.tohead insert 0 $newhead
5791     $top.tohead conf -state readonly
5792     grid x $top.tohead -sticky w
5793     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5794     grid $top.rev x -pady 10
5795     label $top.flab -text "Output file:"
5796     entry $top.fname -width 60
5797     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5798     incr patchnum
5799     grid $top.flab $top.fname -sticky w
5800     frame $top.buts
5801     button $top.buts.gen -text "Generate" -command mkpatchgo
5802     button $top.buts.can -text "Cancel" -command mkpatchcan
5803     grid $top.buts.gen $top.buts.can
5804     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5805     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5806     grid $top.buts - -pady 10 -sticky ew
5807     focus $top.fname
5808 }
5809
5810 proc mkpatchrev {} {
5811     global patchtop
5812
5813     set oldid [$patchtop.fromsha1 get]
5814     set oldhead [$patchtop.fromhead get]
5815     set newid [$patchtop.tosha1 get]
5816     set newhead [$patchtop.tohead get]
5817     foreach e [list fromsha1 fromhead tosha1 tohead] \
5818             v [list $newid $newhead $oldid $oldhead] {
5819         $patchtop.$e conf -state normal
5820         $patchtop.$e delete 0 end
5821         $patchtop.$e insert 0 $v
5822         $patchtop.$e conf -state readonly
5823     }
5824 }
5825
5826 proc mkpatchgo {} {
5827     global patchtop nullid nullid2
5828
5829     set oldid [$patchtop.fromsha1 get]
5830     set newid [$patchtop.tosha1 get]
5831     set fname [$patchtop.fname get]
5832     set cmd [diffcmd [list $oldid $newid] -p]
5833     lappend cmd >$fname &
5834     if {[catch {eval exec $cmd} err]} {
5835         error_popup "Error creating patch: $err"
5836     }
5837     catch {destroy $patchtop}
5838     unset patchtop
5839 }
5840
5841 proc mkpatchcan {} {
5842     global patchtop
5843
5844     catch {destroy $patchtop}
5845     unset patchtop
5846 }
5847
5848 proc mktag {} {
5849     global rowmenuid mktagtop commitinfo
5850
5851     set top .maketag
5852     set mktagtop $top
5853     catch {destroy $top}
5854     toplevel $top
5855     label $top.title -text "Create tag"
5856     grid $top.title - -pady 10
5857     label $top.id -text "ID:"
5858     entry $top.sha1 -width 40 -relief flat
5859     $top.sha1 insert 0 $rowmenuid
5860     $top.sha1 conf -state readonly
5861     grid $top.id $top.sha1 -sticky w
5862     entry $top.head -width 60 -relief flat
5863     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5864     $top.head conf -state readonly
5865     grid x $top.head -sticky w
5866     label $top.tlab -text "Tag name:"
5867     entry $top.tag -width 60
5868     grid $top.tlab $top.tag -sticky w
5869     frame $top.buts
5870     button $top.buts.gen -text "Create" -command mktaggo
5871     button $top.buts.can -text "Cancel" -command mktagcan
5872     grid $top.buts.gen $top.buts.can
5873     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5874     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5875     grid $top.buts - -pady 10 -sticky ew
5876     focus $top.tag
5877 }
5878
5879 proc domktag {} {
5880     global mktagtop env tagids idtags
5881
5882     set id [$mktagtop.sha1 get]
5883     set tag [$mktagtop.tag get]
5884     if {$tag == {}} {
5885         error_popup "No tag name specified"
5886         return
5887     }
5888     if {[info exists tagids($tag)]} {
5889         error_popup "Tag \"$tag\" already exists"
5890         return
5891     }
5892     if {[catch {
5893         set dir [gitdir]
5894         set fname [file join $dir "refs/tags" $tag]
5895         set f [open $fname w]
5896         puts $f $id
5897         close $f
5898     } err]} {
5899         error_popup "Error creating tag: $err"
5900         return
5901     }
5902
5903     set tagids($tag) $id
5904     lappend idtags($id) $tag
5905     redrawtags $id
5906     addedtag $id
5907     dispneartags 0
5908     run refill_reflist
5909 }
5910
5911 proc redrawtags {id} {
5912     global canv linehtag commitrow idpos selectedline curview
5913     global mainfont canvxmax iddrawn
5914
5915     if {![info exists commitrow($curview,$id)]} return
5916     if {![info exists iddrawn($id)]} return
5917     drawcommits $commitrow($curview,$id)
5918     $canv delete tag.$id
5919     set xt [eval drawtags $id $idpos($id)]
5920     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5921     set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5922     set xr [expr {$xt + [font measure $mainfont $text]}]
5923     if {$xr > $canvxmax} {
5924         set canvxmax $xr
5925         setcanvscroll
5926     }
5927     if {[info exists selectedline]
5928         && $selectedline == $commitrow($curview,$id)} {
5929         selectline $selectedline 0
5930     }
5931 }
5932
5933 proc mktagcan {} {
5934     global mktagtop
5935
5936     catch {destroy $mktagtop}
5937     unset mktagtop
5938 }
5939
5940 proc mktaggo {} {
5941     domktag
5942     mktagcan
5943 }
5944
5945 proc writecommit {} {
5946     global rowmenuid wrcomtop commitinfo wrcomcmd
5947
5948     set top .writecommit
5949     set wrcomtop $top
5950     catch {destroy $top}
5951     toplevel $top
5952     label $top.title -text "Write commit to file"
5953     grid $top.title - -pady 10
5954     label $top.id -text "ID:"
5955     entry $top.sha1 -width 40 -relief flat
5956     $top.sha1 insert 0 $rowmenuid
5957     $top.sha1 conf -state readonly
5958     grid $top.id $top.sha1 -sticky w
5959     entry $top.head -width 60 -relief flat
5960     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5961     $top.head conf -state readonly
5962     grid x $top.head -sticky w
5963     label $top.clab -text "Command:"
5964     entry $top.cmd -width 60 -textvariable wrcomcmd
5965     grid $top.clab $top.cmd -sticky w -pady 10
5966     label $top.flab -text "Output file:"
5967     entry $top.fname -width 60
5968     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5969     grid $top.flab $top.fname -sticky w
5970     frame $top.buts
5971     button $top.buts.gen -text "Write" -command wrcomgo
5972     button $top.buts.can -text "Cancel" -command wrcomcan
5973     grid $top.buts.gen $top.buts.can
5974     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5975     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5976     grid $top.buts - -pady 10 -sticky ew
5977     focus $top.fname
5978 }
5979
5980 proc wrcomgo {} {
5981     global wrcomtop
5982
5983     set id [$wrcomtop.sha1 get]
5984     set cmd "echo $id | [$wrcomtop.cmd get]"
5985     set fname [$wrcomtop.fname get]
5986     if {[catch {exec sh -c $cmd >$fname &} err]} {
5987         error_popup "Error writing commit: $err"
5988     }
5989     catch {destroy $wrcomtop}
5990     unset wrcomtop
5991 }
5992
5993 proc wrcomcan {} {
5994     global wrcomtop
5995
5996     catch {destroy $wrcomtop}
5997     unset wrcomtop
5998 }
5999
6000 proc mkbranch {} {
6001     global rowmenuid mkbrtop
6002
6003     set top .makebranch
6004     catch {destroy $top}
6005     toplevel $top
6006     label $top.title -text "Create new branch"
6007     grid $top.title - -pady 10
6008     label $top.id -text "ID:"
6009     entry $top.sha1 -width 40 -relief flat
6010     $top.sha1 insert 0 $rowmenuid
6011     $top.sha1 conf -state readonly
6012     grid $top.id $top.sha1 -sticky w
6013     label $top.nlab -text "Name:"
6014     entry $top.name -width 40
6015     grid $top.nlab $top.name -sticky w
6016     frame $top.buts
6017     button $top.buts.go -text "Create" -command [list mkbrgo $top]
6018     button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
6019     grid $top.buts.go $top.buts.can
6020     grid columnconfigure $top.buts 0 -weight 1 -uniform a
6021     grid columnconfigure $top.buts 1 -weight 1 -uniform a
6022     grid $top.buts - -pady 10 -sticky ew
6023     focus $top.name
6024 }
6025
6026 proc mkbrgo {top} {
6027     global headids idheads
6028
6029     set name [$top.name get]
6030     set id [$top.sha1 get]
6031     if {$name eq {}} {
6032         error_popup "Please specify a name for the new branch"
6033         return
6034     }
6035     catch {destroy $top}
6036     nowbusy newbranch
6037     update
6038     if {[catch {
6039         exec git branch $name $id
6040     } err]} {
6041         notbusy newbranch
6042         error_popup $err
6043     } else {
6044         set headids($name) $id
6045         lappend idheads($id) $name
6046         addedhead $id $name
6047         notbusy newbranch
6048         redrawtags $id
6049         dispneartags 0
6050         run refill_reflist
6051     }
6052 }
6053
6054 proc cherrypick {} {
6055     global rowmenuid curview commitrow
6056     global mainhead
6057
6058     set oldhead [exec git rev-parse HEAD]
6059     set dheads [descheads $rowmenuid]
6060     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6061         set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6062                         included in branch $mainhead -- really re-apply it?"]
6063         if {!$ok} return
6064     }
6065     nowbusy cherrypick
6066     update
6067     # Unfortunately git-cherry-pick writes stuff to stderr even when
6068     # no error occurs, and exec takes that as an indication of error...
6069     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6070         notbusy cherrypick
6071         error_popup $err
6072         return
6073     }
6074     set newhead [exec git rev-parse HEAD]
6075     if {$newhead eq $oldhead} {
6076         notbusy cherrypick
6077         error_popup "No changes committed"
6078         return
6079     }
6080     addnewchild $newhead $oldhead
6081     if {[info exists commitrow($curview,$oldhead)]} {
6082         insertrow $commitrow($curview,$oldhead) $newhead
6083         if {$mainhead ne {}} {
6084             movehead $newhead $mainhead
6085             movedhead $newhead $mainhead
6086         }
6087         redrawtags $oldhead
6088         redrawtags $newhead
6089     }
6090     notbusy cherrypick
6091 }
6092
6093 proc resethead {} {
6094     global mainheadid mainhead rowmenuid confirm_ok resettype
6095     global showlocalchanges
6096
6097     set confirm_ok 0
6098     set w ".confirmreset"
6099     toplevel $w
6100     wm transient $w .
6101     wm title $w "Confirm reset"
6102     message $w.m -text \
6103         "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6104         -justify center -aspect 1000
6105     pack $w.m -side top -fill x -padx 20 -pady 20
6106     frame $w.f -relief sunken -border 2
6107     message $w.f.rt -text "Reset type:" -aspect 1000
6108     grid $w.f.rt -sticky w
6109     set resettype mixed
6110     radiobutton $w.f.soft -value soft -variable resettype -justify left \
6111         -text "Soft: Leave working tree and index untouched"
6112     grid $w.f.soft -sticky w
6113     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6114         -text "Mixed: Leave working tree untouched, reset index"
6115     grid $w.f.mixed -sticky w
6116     radiobutton $w.f.hard -value hard -variable resettype -justify left \
6117         -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6118     grid $w.f.hard -sticky w
6119     pack $w.f -side top -fill x
6120     button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6121     pack $w.ok -side left -fill x -padx 20 -pady 20
6122     button $w.cancel -text Cancel -command "destroy $w"
6123     pack $w.cancel -side right -fill x -padx 20 -pady 20
6124     bind $w <Visibility> "grab $w; focus $w"
6125     tkwait window $w
6126     if {!$confirm_ok} return
6127     if {[catch {set fd [open \
6128             [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6129         error_popup $err
6130     } else {
6131         dohidelocalchanges
6132         set w ".resetprogress"
6133         filerun $fd [list readresetstat $fd $w]
6134         toplevel $w
6135         wm transient $w
6136         wm title $w "Reset progress"
6137         message $w.m -text "Reset in progress, please wait..." \
6138             -justify center -aspect 1000
6139         pack $w.m -side top -fill x -padx 20 -pady 5
6140         canvas $w.c -width 150 -height 20 -bg white
6141         $w.c create rect 0 0 0 20 -fill green -tags rect
6142         pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6143         nowbusy reset
6144     }
6145 }
6146
6147 proc readresetstat {fd w} {
6148     global mainhead mainheadid showlocalchanges
6149
6150     if {[gets $fd line] >= 0} {
6151         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6152             set x [expr {($m * 150) / $n}]
6153             $w.c coords rect 0 0 $x 20
6154         }
6155         return 1
6156     }
6157     destroy $w
6158     notbusy reset
6159     if {[catch {close $fd} err]} {
6160         error_popup $err
6161     }
6162     set oldhead $mainheadid
6163     set newhead [exec git rev-parse HEAD]
6164     if {$newhead ne $oldhead} {
6165         movehead $newhead $mainhead
6166         movedhead $newhead $mainhead
6167         set mainheadid $newhead
6168         redrawtags $oldhead
6169         redrawtags $newhead
6170     }
6171     if {$showlocalchanges} {
6172         doshowlocalchanges
6173     }
6174     return 0
6175 }
6176
6177 # context menu for a head
6178 proc headmenu {x y id head} {
6179     global headmenuid headmenuhead headctxmenu mainhead
6180
6181     set headmenuid $id
6182     set headmenuhead $head
6183     set state normal
6184     if {$head eq $mainhead} {
6185         set state disabled
6186     }
6187     $headctxmenu entryconfigure 0 -state $state
6188     $headctxmenu entryconfigure 1 -state $state
6189     tk_popup $headctxmenu $x $y
6190 }
6191
6192 proc cobranch {} {
6193     global headmenuid headmenuhead mainhead headids
6194     global showlocalchanges mainheadid
6195
6196     # check the tree is clean first??
6197     set oldmainhead $mainhead
6198     nowbusy checkout
6199     update
6200     dohidelocalchanges
6201     if {[catch {
6202         exec git checkout -q $headmenuhead
6203     } err]} {
6204         notbusy checkout
6205         error_popup $err
6206     } else {
6207         notbusy checkout
6208         set mainhead $headmenuhead
6209         set mainheadid $headmenuid
6210         if {[info exists headids($oldmainhead)]} {
6211             redrawtags $headids($oldmainhead)
6212         }
6213         redrawtags $headmenuid
6214     }
6215     if {$showlocalchanges} {
6216         dodiffindex
6217     }
6218 }
6219
6220 proc rmbranch {} {
6221     global headmenuid headmenuhead mainhead
6222     global idheads
6223
6224     set head $headmenuhead
6225     set id $headmenuid
6226     # this check shouldn't be needed any more...
6227     if {$head eq $mainhead} {
6228         error_popup "Cannot delete the currently checked-out branch"
6229         return
6230     }
6231     set dheads [descheads $id]
6232     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6233         # the stuff on this branch isn't on any other branch
6234         if {![confirm_popup "The commits on branch $head aren't on any other\
6235                         branch.\nReally delete branch $head?"]} return
6236     }
6237     nowbusy rmbranch
6238     update
6239     if {[catch {exec git branch -D $head} err]} {
6240         notbusy rmbranch
6241         error_popup $err
6242         return
6243     }
6244     removehead $id $head
6245     removedhead $id $head
6246     redrawtags $id
6247     notbusy rmbranch
6248     dispneartags 0
6249     run refill_reflist
6250 }
6251
6252 # Display a list of tags and heads
6253 proc showrefs {} {
6254     global showrefstop bgcolor fgcolor selectbgcolor mainfont
6255     global bglist fglist uifont reflistfilter reflist maincursor
6256
6257     set top .showrefs
6258     set showrefstop $top
6259     if {[winfo exists $top]} {
6260         raise $top
6261         refill_reflist
6262         return
6263     }
6264     toplevel $top
6265     wm title $top "Tags and heads: [file tail [pwd]]"
6266     text $top.list -background $bgcolor -foreground $fgcolor \
6267         -selectbackground $selectbgcolor -font $mainfont \
6268         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6269         -width 30 -height 20 -cursor $maincursor \
6270         -spacing1 1 -spacing3 1 -state disabled
6271     $top.list tag configure highlight -background $selectbgcolor
6272     lappend bglist $top.list
6273     lappend fglist $top.list
6274     scrollbar $top.ysb -command "$top.list yview" -orient vertical
6275     scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6276     grid $top.list $top.ysb -sticky nsew
6277     grid $top.xsb x -sticky ew
6278     frame $top.f
6279     label $top.f.l -text "Filter: " -font $uifont
6280     entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6281     set reflistfilter "*"
6282     trace add variable reflistfilter write reflistfilter_change
6283     pack $top.f.e -side right -fill x -expand 1
6284     pack $top.f.l -side left
6285     grid $top.f - -sticky ew -pady 2
6286     button $top.close -command [list destroy $top] -text "Close" \
6287         -font $uifont
6288     grid $top.close -
6289     grid columnconfigure $top 0 -weight 1
6290     grid rowconfigure $top 0 -weight 1
6291     bind $top.list <1> {break}
6292     bind $top.list <B1-Motion> {break}
6293     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6294     set reflist {}
6295     refill_reflist
6296 }
6297
6298 proc sel_reflist {w x y} {
6299     global showrefstop reflist headids tagids otherrefids
6300
6301     if {![winfo exists $showrefstop]} return
6302     set l [lindex [split [$w index "@$x,$y"] "."] 0]
6303     set ref [lindex $reflist [expr {$l-1}]]
6304     set n [lindex $ref 0]
6305     switch -- [lindex $ref 1] {
6306         "H" {selbyid $headids($n)}
6307         "T" {selbyid $tagids($n)}
6308         "o" {selbyid $otherrefids($n)}
6309     }
6310     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6311 }
6312
6313 proc unsel_reflist {} {
6314     global showrefstop
6315
6316     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6317     $showrefstop.list tag remove highlight 0.0 end
6318 }
6319
6320 proc reflistfilter_change {n1 n2 op} {
6321     global reflistfilter
6322
6323     after cancel refill_reflist
6324     after 200 refill_reflist
6325 }
6326
6327 proc refill_reflist {} {
6328     global reflist reflistfilter showrefstop headids tagids otherrefids
6329     global commitrow curview commitinterest
6330
6331     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6332     set refs {}
6333     foreach n [array names headids] {
6334         if {[string match $reflistfilter $n]} {
6335             if {[info exists commitrow($curview,$headids($n))]} {
6336                 lappend refs [list $n H]
6337             } else {
6338                 set commitinterest($headids($n)) {run refill_reflist}
6339             }
6340         }
6341     }
6342     foreach n [array names tagids] {
6343         if {[string match $reflistfilter $n]} {
6344             if {[info exists commitrow($curview,$tagids($n))]} {
6345                 lappend refs [list $n T]
6346             } else {
6347                 set commitinterest($tagids($n)) {run refill_reflist}
6348             }
6349         }
6350     }
6351     foreach n [array names otherrefids] {
6352         if {[string match $reflistfilter $n]} {
6353             if {[info exists commitrow($curview,$otherrefids($n))]} {
6354                 lappend refs [list $n o]
6355             } else {
6356                 set commitinterest($otherrefids($n)) {run refill_reflist}
6357             }
6358         }
6359     }
6360     set refs [lsort -index 0 $refs]
6361     if {$refs eq $reflist} return
6362
6363     # Update the contents of $showrefstop.list according to the
6364     # differences between $reflist (old) and $refs (new)
6365     $showrefstop.list conf -state normal
6366     $showrefstop.list insert end "\n"
6367     set i 0
6368     set j 0
6369     while {$i < [llength $reflist] || $j < [llength $refs]} {
6370         if {$i < [llength $reflist]} {
6371             if {$j < [llength $refs]} {
6372                 set cmp [string compare [lindex $reflist $i 0] \
6373                              [lindex $refs $j 0]]
6374                 if {$cmp == 0} {
6375                     set cmp [string compare [lindex $reflist $i 1] \
6376                                  [lindex $refs $j 1]]
6377                 }
6378             } else {
6379                 set cmp -1
6380             }
6381         } else {
6382             set cmp 1
6383         }
6384         switch -- $cmp {
6385             -1 {
6386                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6387                 incr i
6388             }
6389             0 {
6390                 incr i
6391                 incr j
6392             }
6393             1 {
6394                 set l [expr {$j + 1}]
6395                 $showrefstop.list image create $l.0 -align baseline \
6396                     -image reficon-[lindex $refs $j 1] -padx 2
6397                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6398                 incr j
6399             }
6400         }
6401     }
6402     set reflist $refs
6403     # delete last newline
6404     $showrefstop.list delete end-2c end-1c
6405     $showrefstop.list conf -state disabled
6406 }
6407
6408 # Stuff for finding nearby tags
6409 proc getallcommits {} {
6410     global allcommits allids nbmp nextarc seeds
6411
6412     if {![info exists allcommits]} {
6413         set allids {}
6414         set nbmp 0
6415         set nextarc 0
6416         set allcommits 0
6417         set seeds {}
6418     }
6419
6420     set cmd [concat | git rev-list --all --parents]
6421     foreach id $seeds {
6422         lappend cmd "^$id"
6423     }
6424     set fd [open $cmd r]
6425     fconfigure $fd -blocking 0
6426     incr allcommits
6427     nowbusy allcommits
6428     filerun $fd [list getallclines $fd]
6429 }
6430
6431 # Since most commits have 1 parent and 1 child, we group strings of
6432 # such commits into "arcs" joining branch/merge points (BMPs), which
6433 # are commits that either don't have 1 parent or don't have 1 child.
6434 #
6435 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6436 # arcout(id) - outgoing arcs for BMP
6437 # arcids(a) - list of IDs on arc including end but not start
6438 # arcstart(a) - BMP ID at start of arc
6439 # arcend(a) - BMP ID at end of arc
6440 # growing(a) - arc a is still growing
6441 # arctags(a) - IDs out of arcids (excluding end) that have tags
6442 # archeads(a) - IDs out of arcids (excluding end) that have heads
6443 # The start of an arc is at the descendent end, so "incoming" means
6444 # coming from descendents, and "outgoing" means going towards ancestors.
6445
6446 proc getallclines {fd} {
6447     global allids allparents allchildren idtags idheads nextarc nbmp
6448     global arcnos arcids arctags arcout arcend arcstart archeads growing
6449     global seeds allcommits
6450
6451     set nid 0
6452     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6453         set id [lindex $line 0]
6454         if {[info exists allparents($id)]} {
6455             # seen it already
6456             continue
6457         }
6458         lappend allids $id
6459         set olds [lrange $line 1 end]
6460         set allparents($id) $olds
6461         if {![info exists allchildren($id)]} {
6462             set allchildren($id) {}
6463             set arcnos($id) {}
6464             lappend seeds $id
6465         } else {
6466             set a $arcnos($id)
6467             if {[llength $olds] == 1 && [llength $a] == 1} {
6468                 lappend arcids($a) $id
6469                 if {[info exists idtags($id)]} {
6470                     lappend arctags($a) $id
6471                 }
6472                 if {[info exists idheads($id)]} {
6473                     lappend archeads($a) $id
6474                 }
6475                 if {[info exists allparents($olds)]} {
6476                     # seen parent already
6477                     if {![info exists arcout($olds)]} {
6478                         splitarc $olds
6479                     }
6480                     lappend arcids($a) $olds
6481                     set arcend($a) $olds
6482                     unset growing($a)
6483                 }
6484                 lappend allchildren($olds) $id
6485                 lappend arcnos($olds) $a
6486                 continue
6487             }
6488         }
6489         incr nbmp
6490         foreach a $arcnos($id) {
6491             lappend arcids($a) $id
6492             set arcend($a) $id
6493             unset growing($a)
6494         }
6495
6496         set ao {}
6497         foreach p $olds {
6498             lappend allchildren($p) $id
6499             set a [incr nextarc]
6500             set arcstart($a) $id
6501             set archeads($a) {}
6502             set arctags($a) {}
6503             set archeads($a) {}
6504             set arcids($a) {}
6505             lappend ao $a
6506             set growing($a) 1
6507             if {[info exists allparents($p)]} {
6508                 # seen it already, may need to make a new branch
6509                 if {![info exists arcout($p)]} {
6510                     splitarc $p
6511                 }
6512                 lappend arcids($a) $p
6513                 set arcend($a) $p
6514                 unset growing($a)
6515             }
6516             lappend arcnos($p) $a
6517         }
6518         set arcout($id) $ao
6519     }
6520     if {$nid > 0} {
6521         global cached_dheads cached_dtags cached_atags
6522         catch {unset cached_dheads}
6523         catch {unset cached_dtags}
6524         catch {unset cached_atags}
6525     }
6526     if {![eof $fd]} {
6527         return [expr {$nid >= 1000? 2: 1}]
6528     }
6529     close $fd
6530     if {[incr allcommits -1] == 0} {
6531         notbusy allcommits
6532     }
6533     dispneartags 0
6534     return 0
6535 }
6536
6537 proc recalcarc {a} {
6538     global arctags archeads arcids idtags idheads
6539
6540     set at {}
6541     set ah {}
6542     foreach id [lrange $arcids($a) 0 end-1] {
6543         if {[info exists idtags($id)]} {
6544             lappend at $id
6545         }
6546         if {[info exists idheads($id)]} {
6547             lappend ah $id
6548         }
6549     }
6550     set arctags($a) $at
6551     set archeads($a) $ah
6552 }
6553
6554 proc splitarc {p} {
6555     global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6556     global arcstart arcend arcout allparents growing
6557
6558     set a $arcnos($p)
6559     if {[llength $a] != 1} {
6560         puts "oops splitarc called but [llength $a] arcs already"
6561         return
6562     }
6563     set a [lindex $a 0]
6564     set i [lsearch -exact $arcids($a) $p]
6565     if {$i < 0} {
6566         puts "oops splitarc $p not in arc $a"
6567         return
6568     }
6569     set na [incr nextarc]
6570     if {[info exists arcend($a)]} {
6571         set arcend($na) $arcend($a)
6572     } else {
6573         set l [lindex $allparents([lindex $arcids($a) end]) 0]
6574         set j [lsearch -exact $arcnos($l) $a]
6575         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6576     }
6577     set tail [lrange $arcids($a) [expr {$i+1}] end]
6578     set arcids($a) [lrange $arcids($a) 0 $i]
6579     set arcend($a) $p
6580     set arcstart($na) $p
6581     set arcout($p) $na
6582     set arcids($na) $tail
6583     if {[info exists growing($a)]} {
6584         set growing($na) 1
6585         unset growing($a)
6586     }
6587     incr nbmp
6588
6589     foreach id $tail {
6590         if {[llength $arcnos($id)] == 1} {
6591             set arcnos($id) $na
6592         } else {
6593             set j [lsearch -exact $arcnos($id) $a]
6594             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6595         }
6596     }
6597
6598     # reconstruct tags and heads lists
6599     if {$arctags($a) ne {} || $archeads($a) ne {}} {
6600         recalcarc $a
6601         recalcarc $na
6602     } else {
6603         set arctags($na) {}
6604         set archeads($na) {}
6605     }
6606 }
6607
6608 # Update things for a new commit added that is a child of one
6609 # existing commit.  Used when cherry-picking.
6610 proc addnewchild {id p} {
6611     global allids allparents allchildren idtags nextarc nbmp
6612     global arcnos arcids arctags arcout arcend arcstart archeads growing
6613     global seeds
6614
6615     lappend allids $id
6616     set allparents($id) [list $p]
6617     set allchildren($id) {}
6618     set arcnos($id) {}
6619     lappend seeds $id
6620     incr nbmp
6621     lappend allchildren($p) $id
6622     set a [incr nextarc]
6623     set arcstart($a) $id
6624     set archeads($a) {}
6625     set arctags($a) {}
6626     set arcids($a) [list $p]
6627     set arcend($a) $p
6628     if {![info exists arcout($p)]} {
6629         splitarc $p
6630     }
6631     lappend arcnos($p) $a
6632     set arcout($id) [list $a]
6633 }
6634
6635 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6636 # or 0 if neither is true.
6637 proc anc_or_desc {a b} {
6638     global arcout arcstart arcend arcnos cached_isanc
6639
6640     if {$arcnos($a) eq $arcnos($b)} {
6641         # Both are on the same arc(s); either both are the same BMP,
6642         # or if one is not a BMP, the other is also not a BMP or is
6643         # the BMP at end of the arc (and it only has 1 incoming arc).
6644         # Or both can be BMPs with no incoming arcs.
6645         if {$a eq $b || $arcnos($a) eq {}} {
6646             return 0
6647         }
6648         # assert {[llength $arcnos($a)] == 1}
6649         set arc [lindex $arcnos($a) 0]
6650         set i [lsearch -exact $arcids($arc) $a]
6651         set j [lsearch -exact $arcids($arc) $b]
6652         if {$i < 0 || $i > $j} {
6653             return 1
6654         } else {
6655             return -1
6656         }
6657     }
6658
6659     if {![info exists arcout($a)]} {
6660         set arc [lindex $arcnos($a) 0]
6661         if {[info exists arcend($arc)]} {
6662             set aend $arcend($arc)
6663         } else {
6664             set aend {}
6665         }
6666         set a $arcstart($arc)
6667     } else {
6668         set aend $a
6669     }
6670     if {![info exists arcout($b)]} {
6671         set arc [lindex $arcnos($b) 0]
6672         if {[info exists arcend($arc)]} {
6673             set bend $arcend($arc)
6674         } else {
6675             set bend {}
6676         }
6677         set b $arcstart($arc)
6678     } else {
6679         set bend $b
6680     }
6681     if {$a eq $bend} {
6682         return 1
6683     }
6684     if {$b eq $aend} {
6685         return -1
6686     }
6687     if {[info exists cached_isanc($a,$bend)]} {
6688         if {$cached_isanc($a,$bend)} {
6689             return 1
6690         }
6691     }
6692     if {[info exists cached_isanc($b,$aend)]} {
6693         if {$cached_isanc($b,$aend)} {
6694             return -1
6695         }
6696         if {[info exists cached_isanc($a,$bend)]} {
6697             return 0
6698         }
6699     }
6700
6701     set todo [list $a $b]
6702     set anc($a) a
6703     set anc($b) b
6704     for {set i 0} {$i < [llength $todo]} {incr i} {
6705         set x [lindex $todo $i]
6706         if {$anc($x) eq {}} {
6707             continue
6708         }
6709         foreach arc $arcnos($x) {
6710             set xd $arcstart($arc)
6711             if {$xd eq $bend} {
6712                 set cached_isanc($a,$bend) 1
6713                 set cached_isanc($b,$aend) 0
6714                 return 1
6715             } elseif {$xd eq $aend} {
6716                 set cached_isanc($b,$aend) 1
6717                 set cached_isanc($a,$bend) 0
6718                 return -1
6719             }
6720             if {![info exists anc($xd)]} {
6721                 set anc($xd) $anc($x)
6722                 lappend todo $xd
6723             } elseif {$anc($xd) ne $anc($x)} {
6724                 set anc($xd) {}
6725             }
6726         }
6727     }
6728     set cached_isanc($a,$bend) 0
6729     set cached_isanc($b,$aend) 0
6730     return 0
6731 }
6732
6733 # This identifies whether $desc has an ancestor that is
6734 # a growing tip of the graph and which is not an ancestor of $anc
6735 # and returns 0 if so and 1 if not.
6736 # If we subsequently discover a tag on such a growing tip, and that
6737 # turns out to be a descendent of $anc (which it could, since we
6738 # don't necessarily see children before parents), then $desc
6739 # isn't a good choice to display as a descendent tag of
6740 # $anc (since it is the descendent of another tag which is
6741 # a descendent of $anc).  Similarly, $anc isn't a good choice to
6742 # display as a ancestor tag of $desc.
6743 #
6744 proc is_certain {desc anc} {
6745     global arcnos arcout arcstart arcend growing problems
6746
6747     set certain {}
6748     if {[llength $arcnos($anc)] == 1} {
6749         # tags on the same arc are certain
6750         if {$arcnos($desc) eq $arcnos($anc)} {
6751             return 1
6752         }
6753         if {![info exists arcout($anc)]} {
6754             # if $anc is partway along an arc, use the start of the arc instead
6755             set a [lindex $arcnos($anc) 0]
6756             set anc $arcstart($a)
6757         }
6758     }
6759     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6760         set x $desc
6761     } else {
6762         set a [lindex $arcnos($desc) 0]
6763         set x $arcend($a)
6764     }
6765     if {$x == $anc} {
6766         return 1
6767     }
6768     set anclist [list $x]
6769     set dl($x) 1
6770     set nnh 1
6771     set ngrowanc 0
6772     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6773         set x [lindex $anclist $i]
6774         if {$dl($x)} {
6775             incr nnh -1
6776         }
6777         set done($x) 1
6778         foreach a $arcout($x) {
6779             if {[info exists growing($a)]} {
6780                 if {![info exists growanc($x)] && $dl($x)} {
6781                     set growanc($x) 1
6782                     incr ngrowanc
6783                 }
6784             } else {
6785                 set y $arcend($a)
6786                 if {[info exists dl($y)]} {
6787                     if {$dl($y)} {
6788                         if {!$dl($x)} {
6789                             set dl($y) 0
6790                             if {![info exists done($y)]} {
6791                                 incr nnh -1
6792                             }
6793                             if {[info exists growanc($x)]} {
6794                                 incr ngrowanc -1
6795                             }
6796                             set xl [list $y]
6797                             for {set k 0} {$k < [llength $xl]} {incr k} {
6798                                 set z [lindex $xl $k]
6799                                 foreach c $arcout($z) {
6800                                     if {[info exists arcend($c)]} {
6801                                         set v $arcend($c)
6802                                         if {[info exists dl($v)] && $dl($v)} {
6803                                             set dl($v) 0
6804                                             if {![info exists done($v)]} {
6805                                                 incr nnh -1
6806                                             }
6807                                             if {[info exists growanc($v)]} {
6808                                                 incr ngrowanc -1
6809                                             }
6810                                             lappend xl $v
6811                                         }
6812                                     }
6813                                 }
6814                             }
6815                         }
6816                     }
6817                 } elseif {$y eq $anc || !$dl($x)} {
6818                     set dl($y) 0
6819                     lappend anclist $y
6820                 } else {
6821                     set dl($y) 1
6822                     lappend anclist $y
6823                     incr nnh
6824                 }
6825             }
6826         }
6827     }
6828     foreach x [array names growanc] {
6829         if {$dl($x)} {
6830             return 0
6831         }
6832         return 0
6833     }
6834     return 1
6835 }
6836
6837 proc validate_arctags {a} {
6838     global arctags idtags
6839
6840     set i -1
6841     set na $arctags($a)
6842     foreach id $arctags($a) {
6843         incr i
6844         if {![info exists idtags($id)]} {
6845             set na [lreplace $na $i $i]
6846             incr i -1
6847         }
6848     }
6849     set arctags($a) $na
6850 }
6851
6852 proc validate_archeads {a} {
6853     global archeads idheads
6854
6855     set i -1
6856     set na $archeads($a)
6857     foreach id $archeads($a) {
6858         incr i
6859         if {![info exists idheads($id)]} {
6860             set na [lreplace $na $i $i]
6861             incr i -1
6862         }
6863     }
6864     set archeads($a) $na
6865 }
6866
6867 # Return the list of IDs that have tags that are descendents of id,
6868 # ignoring IDs that are descendents of IDs already reported.
6869 proc desctags {id} {
6870     global arcnos arcstart arcids arctags idtags allparents
6871     global growing cached_dtags
6872
6873     if {![info exists allparents($id)]} {
6874         return {}
6875     }
6876     set t1 [clock clicks -milliseconds]
6877     set argid $id
6878     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6879         # part-way along an arc; check that arc first
6880         set a [lindex $arcnos($id) 0]
6881         if {$arctags($a) ne {}} {
6882             validate_arctags $a
6883             set i [lsearch -exact $arcids($a) $id]
6884             set tid {}
6885             foreach t $arctags($a) {
6886                 set j [lsearch -exact $arcids($a) $t]
6887                 if {$j >= $i} break
6888                 set tid $t
6889             }
6890             if {$tid ne {}} {
6891                 return $tid
6892             }
6893         }
6894         set id $arcstart($a)
6895         if {[info exists idtags($id)]} {
6896             return $id
6897         }
6898     }
6899     if {[info exists cached_dtags($id)]} {
6900         return $cached_dtags($id)
6901     }
6902
6903     set origid $id
6904     set todo [list $id]
6905     set queued($id) 1
6906     set nc 1
6907     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6908         set id [lindex $todo $i]
6909         set done($id) 1
6910         set ta [info exists hastaggedancestor($id)]
6911         if {!$ta} {
6912             incr nc -1
6913         }
6914         # ignore tags on starting node
6915         if {!$ta && $i > 0} {
6916             if {[info exists idtags($id)]} {
6917                 set tagloc($id) $id
6918                 set ta 1
6919             } elseif {[info exists cached_dtags($id)]} {
6920                 set tagloc($id) $cached_dtags($id)
6921                 set ta 1
6922             }
6923         }
6924         foreach a $arcnos($id) {
6925             set d $arcstart($a)
6926             if {!$ta && $arctags($a) ne {}} {
6927                 validate_arctags $a
6928                 if {$arctags($a) ne {}} {
6929                     lappend tagloc($id) [lindex $arctags($a) end]
6930                 }
6931             }
6932             if {$ta || $arctags($a) ne {}} {
6933                 set tomark [list $d]
6934                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6935                     set dd [lindex $tomark $j]
6936                     if {![info exists hastaggedancestor($dd)]} {
6937                         if {[info exists done($dd)]} {
6938                             foreach b $arcnos($dd) {
6939                                 lappend tomark $arcstart($b)
6940                             }
6941                             if {[info exists tagloc($dd)]} {
6942                                 unset tagloc($dd)
6943                             }
6944                         } elseif {[info exists queued($dd)]} {
6945                             incr nc -1
6946                         }
6947                         set hastaggedancestor($dd) 1
6948                     }
6949                 }
6950             }
6951             if {![info exists queued($d)]} {
6952                 lappend todo $d
6953                 set queued($d) 1
6954                 if {![info exists hastaggedancestor($d)]} {
6955                     incr nc
6956                 }
6957             }
6958         }
6959     }
6960     set tags {}
6961     foreach id [array names tagloc] {
6962         if {![info exists hastaggedancestor($id)]} {
6963             foreach t $tagloc($id) {
6964                 if {[lsearch -exact $tags $t] < 0} {
6965                     lappend tags $t
6966                 }
6967             }
6968         }
6969     }
6970     set t2 [clock clicks -milliseconds]
6971     set loopix $i
6972
6973     # remove tags that are descendents of other tags
6974     for {set i 0} {$i < [llength $tags]} {incr i} {
6975         set a [lindex $tags $i]
6976         for {set j 0} {$j < $i} {incr j} {
6977             set b [lindex $tags $j]
6978             set r [anc_or_desc $a $b]
6979             if {$r == 1} {
6980                 set tags [lreplace $tags $j $j]
6981                 incr j -1
6982                 incr i -1
6983             } elseif {$r == -1} {
6984                 set tags [lreplace $tags $i $i]
6985                 incr i -1
6986                 break
6987             }
6988         }
6989     }
6990
6991     if {[array names growing] ne {}} {
6992         # graph isn't finished, need to check if any tag could get
6993         # eclipsed by another tag coming later.  Simply ignore any
6994         # tags that could later get eclipsed.
6995         set ctags {}
6996         foreach t $tags {
6997             if {[is_certain $t $origid]} {
6998                 lappend ctags $t
6999             }
7000         }
7001         if {$tags eq $ctags} {
7002             set cached_dtags($origid) $tags
7003         } else {
7004             set tags $ctags
7005         }
7006     } else {
7007         set cached_dtags($origid) $tags
7008     }
7009     set t3 [clock clicks -milliseconds]
7010     if {0 && $t3 - $t1 >= 100} {
7011         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7012             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7013     }
7014     return $tags
7015 }
7016
7017 proc anctags {id} {
7018     global arcnos arcids arcout arcend arctags idtags allparents
7019     global growing cached_atags
7020
7021     if {![info exists allparents($id)]} {
7022         return {}
7023     }
7024     set t1 [clock clicks -milliseconds]
7025     set argid $id
7026     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7027         # part-way along an arc; check that arc first
7028         set a [lindex $arcnos($id) 0]
7029         if {$arctags($a) ne {}} {
7030             validate_arctags $a
7031             set i [lsearch -exact $arcids($a) $id]
7032             foreach t $arctags($a) {
7033                 set j [lsearch -exact $arcids($a) $t]
7034                 if {$j > $i} {
7035                     return $t
7036                 }
7037             }
7038         }
7039         if {![info exists arcend($a)]} {
7040             return {}
7041         }
7042         set id $arcend($a)
7043         if {[info exists idtags($id)]} {
7044             return $id
7045         }
7046     }
7047     if {[info exists cached_atags($id)]} {
7048         return $cached_atags($id)
7049     }
7050
7051     set origid $id
7052     set todo [list $id]
7053     set queued($id) 1
7054     set taglist {}
7055     set nc 1
7056     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7057         set id [lindex $todo $i]
7058         set done($id) 1
7059         set td [info exists hastaggeddescendent($id)]
7060         if {!$td} {
7061             incr nc -1
7062         }
7063         # ignore tags on starting node
7064         if {!$td && $i > 0} {
7065             if {[info exists idtags($id)]} {
7066                 set tagloc($id) $id
7067                 set td 1
7068             } elseif {[info exists cached_atags($id)]} {
7069                 set tagloc($id) $cached_atags($id)
7070                 set td 1
7071             }
7072         }
7073         foreach a $arcout($id) {
7074             if {!$td && $arctags($a) ne {}} {
7075                 validate_arctags $a
7076                 if {$arctags($a) ne {}} {
7077                     lappend tagloc($id) [lindex $arctags($a) 0]
7078                 }
7079             }
7080             if {![info exists arcend($a)]} continue
7081             set d $arcend($a)
7082             if {$td || $arctags($a) ne {}} {
7083                 set tomark [list $d]
7084                 for {set j 0} {$j < [llength $tomark]} {incr j} {
7085                     set dd [lindex $tomark $j]
7086                     if {![info exists hastaggeddescendent($dd)]} {
7087                         if {[info exists done($dd)]} {
7088                             foreach b $arcout($dd) {
7089                                 if {[info exists arcend($b)]} {
7090                                     lappend tomark $arcend($b)
7091                                 }
7092                             }
7093                             if {[info exists tagloc($dd)]} {
7094                                 unset tagloc($dd)
7095                             }
7096                         } elseif {[info exists queued($dd)]} {
7097                             incr nc -1
7098                         }
7099                         set hastaggeddescendent($dd) 1
7100                     }
7101                 }
7102             }
7103             if {![info exists queued($d)]} {
7104                 lappend todo $d
7105                 set queued($d) 1
7106                 if {![info exists hastaggeddescendent($d)]} {
7107                     incr nc
7108                 }
7109             }
7110         }
7111     }
7112     set t2 [clock clicks -milliseconds]
7113     set loopix $i
7114     set tags {}
7115     foreach id [array names tagloc] {
7116         if {![info exists hastaggeddescendent($id)]} {
7117             foreach t $tagloc($id) {
7118                 if {[lsearch -exact $tags $t] < 0} {
7119                     lappend tags $t
7120                 }
7121             }
7122         }
7123     }
7124
7125     # remove tags that are ancestors of other tags
7126     for {set i 0} {$i < [llength $tags]} {incr i} {
7127         set a [lindex $tags $i]
7128         for {set j 0} {$j < $i} {incr j} {
7129             set b [lindex $tags $j]
7130             set r [anc_or_desc $a $b]
7131             if {$r == -1} {
7132                 set tags [lreplace $tags $j $j]
7133                 incr j -1
7134                 incr i -1
7135             } elseif {$r == 1} {
7136                 set tags [lreplace $tags $i $i]
7137                 incr i -1
7138                 break
7139             }
7140         }
7141     }
7142
7143     if {[array names growing] ne {}} {
7144         # graph isn't finished, need to check if any tag could get
7145         # eclipsed by another tag coming later.  Simply ignore any
7146         # tags that could later get eclipsed.
7147         set ctags {}
7148         foreach t $tags {
7149             if {[is_certain $origid $t]} {
7150                 lappend ctags $t
7151             }
7152         }
7153         if {$tags eq $ctags} {
7154             set cached_atags($origid) $tags
7155         } else {
7156             set tags $ctags
7157         }
7158     } else {
7159         set cached_atags($origid) $tags
7160     }
7161     set t3 [clock clicks -milliseconds]
7162     if {0 && $t3 - $t1 >= 100} {
7163         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7164             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7165     }
7166     return $tags
7167 }
7168
7169 # Return the list of IDs that have heads that are descendents of id,
7170 # including id itself if it has a head.
7171 proc descheads {id} {
7172     global arcnos arcstart arcids archeads idheads cached_dheads
7173     global allparents
7174
7175     if {![info exists allparents($id)]} {
7176         return {}
7177     }
7178     set aret {}
7179     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7180         # part-way along an arc; check it first
7181         set a [lindex $arcnos($id) 0]
7182         if {$archeads($a) ne {}} {
7183             validate_archeads $a
7184             set i [lsearch -exact $arcids($a) $id]
7185             foreach t $archeads($a) {
7186                 set j [lsearch -exact $arcids($a) $t]
7187                 if {$j > $i} break
7188                 lappend aret $t
7189             }
7190         }
7191         set id $arcstart($a)
7192     }
7193     set origid $id
7194     set todo [list $id]
7195     set seen($id) 1
7196     set ret {}
7197     for {set i 0} {$i < [llength $todo]} {incr i} {
7198         set id [lindex $todo $i]
7199         if {[info exists cached_dheads($id)]} {
7200             set ret [concat $ret $cached_dheads($id)]
7201         } else {
7202             if {[info exists idheads($id)]} {
7203                 lappend ret $id
7204             }
7205             foreach a $arcnos($id) {
7206                 if {$archeads($a) ne {}} {
7207                     validate_archeads $a
7208                     if {$archeads($a) ne {}} {
7209                         set ret [concat $ret $archeads($a)]
7210                     }
7211                 }
7212                 set d $arcstart($a)
7213                 if {![info exists seen($d)]} {
7214                     lappend todo $d
7215                     set seen($d) 1
7216                 }
7217             }
7218         }
7219     }
7220     set ret [lsort -unique $ret]
7221     set cached_dheads($origid) $ret
7222     return [concat $ret $aret]
7223 }
7224
7225 proc addedtag {id} {
7226     global arcnos arcout cached_dtags cached_atags
7227
7228     if {![info exists arcnos($id)]} return
7229     if {![info exists arcout($id)]} {
7230         recalcarc [lindex $arcnos($id) 0]
7231     }
7232     catch {unset cached_dtags}
7233     catch {unset cached_atags}
7234 }
7235
7236 proc addedhead {hid head} {
7237     global arcnos arcout cached_dheads
7238
7239     if {![info exists arcnos($hid)]} return
7240     if {![info exists arcout($hid)]} {
7241         recalcarc [lindex $arcnos($hid) 0]
7242     }
7243     catch {unset cached_dheads}
7244 }
7245
7246 proc removedhead {hid head} {
7247     global cached_dheads
7248
7249     catch {unset cached_dheads}
7250 }
7251
7252 proc movedhead {hid head} {
7253     global arcnos arcout cached_dheads
7254
7255     if {![info exists arcnos($hid)]} return
7256     if {![info exists arcout($hid)]} {
7257         recalcarc [lindex $arcnos($hid) 0]
7258     }
7259     catch {unset cached_dheads}
7260 }
7261
7262 proc changedrefs {} {
7263     global cached_dheads cached_dtags cached_atags
7264     global arctags archeads arcnos arcout idheads idtags
7265
7266     foreach id [concat [array names idheads] [array names idtags]] {
7267         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7268             set a [lindex $arcnos($id) 0]
7269             if {![info exists donearc($a)]} {
7270                 recalcarc $a
7271                 set donearc($a) 1
7272             }
7273         }
7274     }
7275     catch {unset cached_dtags}
7276     catch {unset cached_atags}
7277     catch {unset cached_dheads}
7278 }
7279
7280 proc rereadrefs {} {
7281     global idtags idheads idotherrefs mainhead
7282
7283     set refids [concat [array names idtags] \
7284                     [array names idheads] [array names idotherrefs]]
7285     foreach id $refids {
7286         if {![info exists ref($id)]} {
7287             set ref($id) [listrefs $id]
7288         }
7289     }
7290     set oldmainhead $mainhead
7291     readrefs
7292     changedrefs
7293     set refids [lsort -unique [concat $refids [array names idtags] \
7294                         [array names idheads] [array names idotherrefs]]]
7295     foreach id $refids {
7296         set v [listrefs $id]
7297         if {![info exists ref($id)] || $ref($id) != $v ||
7298             ($id eq $oldmainhead && $id ne $mainhead) ||
7299             ($id eq $mainhead && $id ne $oldmainhead)} {
7300             redrawtags $id
7301         }
7302     }
7303     run refill_reflist
7304 }
7305
7306 proc listrefs {id} {
7307     global idtags idheads idotherrefs
7308
7309     set x {}
7310     if {[info exists idtags($id)]} {
7311         set x $idtags($id)
7312     }
7313     set y {}
7314     if {[info exists idheads($id)]} {
7315         set y $idheads($id)
7316     }
7317     set z {}
7318     if {[info exists idotherrefs($id)]} {
7319         set z $idotherrefs($id)
7320     }
7321     return [list $x $y $z]
7322 }
7323
7324 proc showtag {tag isnew} {
7325     global ctext tagcontents tagids linknum tagobjid
7326
7327     if {$isnew} {
7328         addtohistory [list showtag $tag 0]
7329     }
7330     $ctext conf -state normal
7331     clear_ctext
7332     set linknum 0
7333     if {![info exists tagcontents($tag)]} {
7334         catch {
7335             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7336         }
7337     }
7338     if {[info exists tagcontents($tag)]} {
7339         set text $tagcontents($tag)
7340     } else {
7341         set text "Tag: $tag\nId:  $tagids($tag)"
7342     }
7343     appendwithlinks $text {}
7344     $ctext conf -state disabled
7345     init_flist {}
7346 }
7347
7348 proc doquit {} {
7349     global stopped
7350     set stopped 100
7351     savestuff .
7352     destroy .
7353 }
7354
7355 proc doprefs {} {
7356     global maxwidth maxgraphpct diffopts
7357     global oldprefs prefstop showneartags showlocalchanges
7358     global bgcolor fgcolor ctext diffcolors selectbgcolor
7359     global uifont tabstop
7360
7361     set top .gitkprefs
7362     set prefstop $top
7363     if {[winfo exists $top]} {
7364         raise $top
7365         return
7366     }
7367     foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7368         set oldprefs($v) [set $v]
7369     }
7370     toplevel $top
7371     wm title $top "Gitk preferences"
7372     label $top.ldisp -text "Commit list display options"
7373     $top.ldisp configure -font $uifont
7374     grid $top.ldisp - -sticky w -pady 10
7375     label $top.spacer -text " "
7376     label $top.maxwidthl -text "Maximum graph width (lines)" \
7377         -font optionfont
7378     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7379     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7380     label $top.maxpctl -text "Maximum graph width (% of pane)" \
7381         -font optionfont
7382     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7383     grid x $top.maxpctl $top.maxpct -sticky w
7384     frame $top.showlocal
7385     label $top.showlocal.l -text "Show local changes" -font optionfont
7386     checkbutton $top.showlocal.b -variable showlocalchanges
7387     pack $top.showlocal.b $top.showlocal.l -side left
7388     grid x $top.showlocal -sticky w
7389
7390     label $top.ddisp -text "Diff display options"
7391     $top.ddisp configure -font $uifont
7392     grid $top.ddisp - -sticky w -pady 10
7393     label $top.diffoptl -text "Options for diff program" \
7394         -font optionfont
7395     entry $top.diffopt -width 20 -textvariable diffopts
7396     grid x $top.diffoptl $top.diffopt -sticky w
7397     frame $top.ntag
7398     label $top.ntag.l -text "Display nearby tags" -font optionfont
7399     checkbutton $top.ntag.b -variable showneartags
7400     pack $top.ntag.b $top.ntag.l -side left
7401     grid x $top.ntag -sticky w
7402     label $top.tabstopl -text "tabstop" -font optionfont
7403     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7404     grid x $top.tabstopl $top.tabstop -sticky w
7405
7406     label $top.cdisp -text "Colors: press to choose"
7407     $top.cdisp configure -font $uifont
7408     grid $top.cdisp - -sticky w -pady 10
7409     label $top.bg -padx 40 -relief sunk -background $bgcolor
7410     button $top.bgbut -text "Background" -font optionfont \
7411         -command [list choosecolor bgcolor 0 $top.bg background setbg]
7412     grid x $top.bgbut $top.bg -sticky w
7413     label $top.fg -padx 40 -relief sunk -background $fgcolor
7414     button $top.fgbut -text "Foreground" -font optionfont \
7415         -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7416     grid x $top.fgbut $top.fg -sticky w
7417     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7418     button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7419         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7420                       [list $ctext tag conf d0 -foreground]]
7421     grid x $top.diffoldbut $top.diffold -sticky w
7422     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7423     button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7424         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7425                       [list $ctext tag conf d1 -foreground]]
7426     grid x $top.diffnewbut $top.diffnew -sticky w
7427     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7428     button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7429         -command [list choosecolor diffcolors 2 $top.hunksep \
7430                       "diff hunk header" \
7431                       [list $ctext tag conf hunksep -foreground]]
7432     grid x $top.hunksepbut $top.hunksep -sticky w
7433     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7434     button $top.selbgbut -text "Select bg" -font optionfont \
7435         -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7436     grid x $top.selbgbut $top.selbgsep -sticky w
7437
7438     frame $top.buts
7439     button $top.buts.ok -text "OK" -command prefsok -default active
7440     $top.buts.ok configure -font $uifont
7441     button $top.buts.can -text "Cancel" -command prefscan -default normal
7442     $top.buts.can configure -font $uifont
7443     grid $top.buts.ok $top.buts.can
7444     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7445     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7446     grid $top.buts - - -pady 10 -sticky ew
7447     bind $top <Visibility> "focus $top.buts.ok"
7448 }
7449
7450 proc choosecolor {v vi w x cmd} {
7451     global $v
7452
7453     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7454                -title "Gitk: choose color for $x"]
7455     if {$c eq {}} return
7456     $w conf -background $c
7457     lset $v $vi $c
7458     eval $cmd $c
7459 }
7460
7461 proc setselbg {c} {
7462     global bglist cflist
7463     foreach w $bglist {
7464         $w configure -selectbackground $c
7465     }
7466     $cflist tag configure highlight \
7467         -background [$cflist cget -selectbackground]
7468     allcanvs itemconf secsel -fill $c
7469 }
7470
7471 proc setbg {c} {
7472     global bglist
7473
7474     foreach w $bglist {
7475         $w conf -background $c
7476     }
7477 }
7478
7479 proc setfg {c} {
7480     global fglist canv
7481
7482     foreach w $fglist {
7483         $w conf -foreground $c
7484     }
7485     allcanvs itemconf text -fill $c
7486     $canv itemconf circle -outline $c
7487 }
7488
7489 proc prefscan {} {
7490     global maxwidth maxgraphpct diffopts
7491     global oldprefs prefstop showneartags showlocalchanges
7492
7493     foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7494         set $v $oldprefs($v)
7495     }
7496     catch {destroy $prefstop}
7497     unset prefstop
7498 }
7499
7500 proc prefsok {} {
7501     global maxwidth maxgraphpct
7502     global oldprefs prefstop showneartags showlocalchanges
7503     global charspc ctext tabstop
7504
7505     catch {destroy $prefstop}
7506     unset prefstop
7507     $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7508     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7509         if {$showlocalchanges} {
7510             doshowlocalchanges
7511         } else {
7512             dohidelocalchanges
7513         }
7514     }
7515     if {$maxwidth != $oldprefs(maxwidth)
7516         || $maxgraphpct != $oldprefs(maxgraphpct)} {
7517         redisplay
7518     } elseif {$showneartags != $oldprefs(showneartags)} {
7519         reselectline
7520     }
7521 }
7522
7523 proc formatdate {d} {
7524     global datetimeformat
7525     if {$d ne {}} {
7526         set d [clock format $d -format $datetimeformat]
7527     }
7528     return $d
7529 }
7530
7531 # This list of encoding names and aliases is distilled from
7532 # http://www.iana.org/assignments/character-sets.
7533 # Not all of them are supported by Tcl.
7534 set encoding_aliases {
7535     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7536       ISO646-US US-ASCII us IBM367 cp367 csASCII }
7537     { ISO-10646-UTF-1 csISO10646UTF1 }
7538     { ISO_646.basic:1983 ref csISO646basic1983 }
7539     { INVARIANT csINVARIANT }
7540     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7541     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7542     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7543     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7544     { NATS-DANO iso-ir-9-1 csNATSDANO }
7545     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7546     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7547     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7548     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7549     { ISO-2022-KR csISO2022KR }
7550     { EUC-KR csEUCKR }
7551     { ISO-2022-JP csISO2022JP }
7552     { ISO-2022-JP-2 csISO2022JP2 }
7553     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7554       csISO13JISC6220jp }
7555     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7556     { IT iso-ir-15 ISO646-IT csISO15Italian }
7557     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7558     { ES iso-ir-17 ISO646-ES csISO17Spanish }
7559     { greek7-old iso-ir-18 csISO18Greek7Old }
7560     { latin-greek iso-ir-19 csISO19LatinGreek }
7561     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7562     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7563     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7564     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7565     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7566     { BS_viewdata iso-ir-47 csISO47BSViewdata }
7567     { INIS iso-ir-49 csISO49INIS }
7568     { INIS-8 iso-ir-50 csISO50INIS8 }
7569     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7570     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7571     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7572     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7573     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7574     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7575       csISO60Norwegian1 }
7576     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7577     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7578     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7579     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7580     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7581     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7582     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7583     { greek7 iso-ir-88 csISO88Greek7 }
7584     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7585     { iso-ir-90 csISO90 }
7586     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7587     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7588       csISO92JISC62991984b }
7589     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7590     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7591     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7592       csISO95JIS62291984handadd }
7593     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7594     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7595     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7596     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7597       CP819 csISOLatin1 }
7598     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7599     { T.61-7bit iso-ir-102 csISO102T617bit }
7600     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7601     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7602     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7603     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7604     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7605     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7606     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7607     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7608       arabic csISOLatinArabic }
7609     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7610     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7611     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7612       greek greek8 csISOLatinGreek }
7613     { T.101-G2 iso-ir-128 csISO128T101G2 }
7614     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7615       csISOLatinHebrew }
7616     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7617     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7618     { CSN_369103 iso-ir-139 csISO139CSN369103 }
7619     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7620     { ISO_6937-2-add iso-ir-142 csISOTextComm }
7621     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7622     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7623       csISOLatinCyrillic }
7624     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7625     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7626     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7627     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7628     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7629     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7630     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7631     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7632     { ISO_10367-box iso-ir-155 csISO10367Box }
7633     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7634     { latin-lap lap iso-ir-158 csISO158Lap }
7635     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7636     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7637     { us-dk csUSDK }
7638     { dk-us csDKUS }
7639     { JIS_X0201 X0201 csHalfWidthKatakana }
7640     { KSC5636 ISO646-KR csKSC5636 }
7641     { ISO-10646-UCS-2 csUnicode }
7642     { ISO-10646-UCS-4 csUCS4 }
7643     { DEC-MCS dec csDECMCS }
7644     { hp-roman8 roman8 r8 csHPRoman8 }
7645     { macintosh mac csMacintosh }
7646     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7647       csIBM037 }
7648     { IBM038 EBCDIC-INT cp038 csIBM038 }
7649     { IBM273 CP273 csIBM273 }
7650     { IBM274 EBCDIC-BE CP274 csIBM274 }
7651     { IBM275 EBCDIC-BR cp275 csIBM275 }
7652     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7653     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7654     { IBM280 CP280 ebcdic-cp-it csIBM280 }
7655     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7656     { IBM284 CP284 ebcdic-cp-es csIBM284 }
7657     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7658     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7659     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7660     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7661     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7662     { IBM424 cp424 ebcdic-cp-he csIBM424 }
7663     { IBM437 cp437 437 csPC8CodePage437 }
7664     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7665     { IBM775 cp775 csPC775Baltic }
7666     { IBM850 cp850 850 csPC850Multilingual }
7667     { IBM851 cp851 851 csIBM851 }
7668     { IBM852 cp852 852 csPCp852 }
7669     { IBM855 cp855 855 csIBM855 }
7670     { IBM857 cp857 857 csIBM857 }
7671     { IBM860 cp860 860 csIBM860 }
7672     { IBM861 cp861 861 cp-is csIBM861 }
7673     { IBM862 cp862 862 csPC862LatinHebrew }
7674     { IBM863 cp863 863 csIBM863 }
7675     { IBM864 cp864 csIBM864 }
7676     { IBM865 cp865 865 csIBM865 }
7677     { IBM866 cp866 866 csIBM866 }
7678     { IBM868 CP868 cp-ar csIBM868 }
7679     { IBM869 cp869 869 cp-gr csIBM869 }
7680     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7681     { IBM871 CP871 ebcdic-cp-is csIBM871 }
7682     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7683     { IBM891 cp891 csIBM891 }
7684     { IBM903 cp903 csIBM903 }
7685     { IBM904 cp904 904 csIBBM904 }
7686     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7687     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7688     { IBM1026 CP1026 csIBM1026 }
7689     { EBCDIC-AT-DE csIBMEBCDICATDE }
7690     { EBCDIC-AT-DE-A csEBCDICATDEA }
7691     { EBCDIC-CA-FR csEBCDICCAFR }
7692     { EBCDIC-DK-NO csEBCDICDKNO }
7693     { EBCDIC-DK-NO-A csEBCDICDKNOA }
7694     { EBCDIC-FI-SE csEBCDICFISE }
7695     { EBCDIC-FI-SE-A csEBCDICFISEA }
7696     { EBCDIC-FR csEBCDICFR }
7697     { EBCDIC-IT csEBCDICIT }
7698     { EBCDIC-PT csEBCDICPT }
7699     { EBCDIC-ES csEBCDICES }
7700     { EBCDIC-ES-A csEBCDICESA }
7701     { EBCDIC-ES-S csEBCDICESS }
7702     { EBCDIC-UK csEBCDICUK }
7703     { EBCDIC-US csEBCDICUS }
7704     { UNKNOWN-8BIT csUnknown8BiT }
7705     { MNEMONIC csMnemonic }
7706     { MNEM csMnem }
7707     { VISCII csVISCII }
7708     { VIQR csVIQR }
7709     { KOI8-R csKOI8R }
7710     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7711     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7712     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7713     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7714     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7715     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7716     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7717     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7718     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7719     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7720     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7721     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7722     { IBM1047 IBM-1047 }
7723     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7724     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7725     { UNICODE-1-1 csUnicode11 }
7726     { CESU-8 csCESU-8 }
7727     { BOCU-1 csBOCU-1 }
7728     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7729     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7730       l8 }
7731     { ISO-8859-15 ISO_8859-15 Latin-9 }
7732     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7733     { GBK CP936 MS936 windows-936 }
7734     { JIS_Encoding csJISEncoding }
7735     { Shift_JIS MS_Kanji csShiftJIS }
7736     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7737       EUC-JP }
7738     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7739     { ISO-10646-UCS-Basic csUnicodeASCII }
7740     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7741     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7742     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7743     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7744     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7745     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7746     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7747     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7748     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7749     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7750     { Adobe-Standard-Encoding csAdobeStandardEncoding }
7751     { Ventura-US csVenturaUS }
7752     { Ventura-International csVenturaInternational }
7753     { PC8-Danish-Norwegian csPC8DanishNorwegian }
7754     { PC8-Turkish csPC8Turkish }
7755     { IBM-Symbols csIBMSymbols }
7756     { IBM-Thai csIBMThai }
7757     { HP-Legal csHPLegal }
7758     { HP-Pi-font csHPPiFont }
7759     { HP-Math8 csHPMath8 }
7760     { Adobe-Symbol-Encoding csHPPSMath }
7761     { HP-DeskTop csHPDesktop }
7762     { Ventura-Math csVenturaMath }
7763     { Microsoft-Publishing csMicrosoftPublishing }
7764     { Windows-31J csWindows31J }
7765     { GB2312 csGB2312 }
7766     { Big5 csBig5 }
7767 }
7768
7769 proc tcl_encoding {enc} {
7770     global encoding_aliases
7771     set names [encoding names]
7772     set lcnames [string tolower $names]
7773     set enc [string tolower $enc]
7774     set i [lsearch -exact $lcnames $enc]
7775     if {$i < 0} {
7776         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7777         if {[regsub {^iso[-_]} $enc iso encx]} {
7778             set i [lsearch -exact $lcnames $encx]
7779         }
7780     }
7781     if {$i < 0} {
7782         foreach l $encoding_aliases {
7783             set ll [string tolower $l]
7784             if {[lsearch -exact $ll $enc] < 0} continue
7785             # look through the aliases for one that tcl knows about
7786             foreach e $ll {
7787                 set i [lsearch -exact $lcnames $e]
7788                 if {$i < 0} {
7789                     if {[regsub {^iso[-_]} $e iso ex]} {
7790                         set i [lsearch -exact $lcnames $ex]
7791                     }
7792                 }
7793                 if {$i >= 0} break
7794             }
7795             break
7796         }
7797     }
7798     if {$i >= 0} {
7799         return [lindex $names $i]
7800     }
7801     return {}
7802 }
7803
7804 # defaults...
7805 set datemode 0
7806 set diffopts "-U 5 -p"
7807 set wrcomcmd "git diff-tree --stdin -p --pretty"
7808
7809 set gitencoding {}
7810 catch {
7811     set gitencoding [exec git config --get i18n.commitencoding]
7812 }
7813 if {$gitencoding == ""} {
7814     set gitencoding "utf-8"
7815 }
7816 set tclencoding [tcl_encoding $gitencoding]
7817 if {$tclencoding == {}} {
7818     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7819 }
7820
7821 set mainfont {Helvetica 9}
7822 set textfont {Courier 9}
7823 set uifont {Helvetica 9 bold}
7824 set tabstop 8
7825 set findmergefiles 0
7826 set maxgraphpct 50
7827 set maxwidth 16
7828 set revlistorder 0
7829 set fastdate 0
7830 set uparrowlen 5
7831 set downarrowlen 5
7832 set mingaplen 100
7833 set cmitmode "patch"
7834 set wrapcomment "none"
7835 set showneartags 1
7836 set maxrefs 20
7837 set maxlinelen 200
7838 set showlocalchanges 1
7839 set datetimeformat "%Y-%m-%d %H:%M:%S"
7840
7841 set colors {green red blue magenta darkgrey brown orange}
7842 set bgcolor white
7843 set fgcolor black
7844 set diffcolors {red "#00a000" blue}
7845 set diffcontext 3
7846 set selectbgcolor gray85
7847
7848 catch {source ~/.gitk}
7849
7850 font create optionfont -family sans-serif -size -12
7851
7852 # check that we can find a .git directory somewhere...
7853 if {[catch {set gitdir [gitdir]}]} {
7854     show_error {} . "Cannot find a git repository here."
7855     exit 1
7856 }
7857 if {![file isdirectory $gitdir]} {
7858     show_error {} . "Cannot find the git directory \"$gitdir\"."
7859     exit 1
7860 }
7861
7862 set revtreeargs {}
7863 set cmdline_files {}
7864 set i 0
7865 foreach arg $argv {
7866     switch -- $arg {
7867         "" { }
7868         "-d" { set datemode 1 }
7869         "--" {
7870             set cmdline_files [lrange $argv [expr {$i + 1}] end]
7871             break
7872         }
7873         default {
7874             lappend revtreeargs $arg
7875         }
7876     }
7877     incr i
7878 }
7879
7880 if {$i >= [llength $argv] && $revtreeargs ne {}} {
7881     # no -- on command line, but some arguments (other than -d)
7882     if {[catch {
7883         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7884         set cmdline_files [split $f "\n"]
7885         set n [llength $cmdline_files]
7886         set revtreeargs [lrange $revtreeargs 0 end-$n]
7887         # Unfortunately git rev-parse doesn't produce an error when
7888         # something is both a revision and a filename.  To be consistent
7889         # with git log and git rev-list, check revtreeargs for filenames.
7890         foreach arg $revtreeargs {
7891             if {[file exists $arg]} {
7892                 show_error {} . "Ambiguous argument '$arg': both revision\
7893                                  and filename"
7894                 exit 1
7895             }
7896         }
7897     } err]} {
7898         # unfortunately we get both stdout and stderr in $err,
7899         # so look for "fatal:".
7900         set i [string first "fatal:" $err]
7901         if {$i > 0} {
7902             set err [string range $err [expr {$i + 6}] end]
7903         }
7904         show_error {} . "Bad arguments to gitk:\n$err"
7905         exit 1
7906     }
7907 }
7908
7909 set nullid "0000000000000000000000000000000000000000"
7910 set nullid2 "0000000000000000000000000000000000000001"
7911
7912
7913 set runq {}
7914 set history {}
7915 set historyindex 0
7916 set fh_serial 0
7917 set nhl_names {}
7918 set highlight_paths {}
7919 set searchdirn -forwards
7920 set boldrows {}
7921 set boldnamerows {}
7922 set diffelide {0 0}
7923 set markingmatches 0
7924 set linkentercount 0
7925
7926 set optim_delay 16
7927
7928 set nextviewnum 1
7929 set curview 0
7930 set selectedview 0
7931 set selectedhlview None
7932 set viewfiles(0) {}
7933 set viewperm(0) 0
7934 set viewargs(0) {}
7935
7936 set cmdlineok 0
7937 set stopped 0
7938 set stuffsaved 0
7939 set patchnum 0
7940 set lookingforhead 0
7941 set localirow -1
7942 set localfrow -1
7943 set lserial 0
7944 setcoords
7945 makewindow
7946 # wait for the window to become visible
7947 tkwait visibility .
7948 wm title . "[file tail $argv0]: [file tail [pwd]]"
7949 readrefs
7950
7951 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7952     # create a view for the files/dirs specified on the command line
7953     set curview 1
7954     set selectedview 1
7955     set nextviewnum 2
7956     set viewname(1) "Command line"
7957     set viewfiles(1) $cmdline_files
7958     set viewargs(1) $revtreeargs
7959     set viewperm(1) 0
7960     addviewmenu 1
7961     .bar.view entryconf Edit* -state normal
7962     .bar.view entryconf Delete* -state normal
7963 }
7964
7965 if {[info exists permviews]} {
7966     foreach v $permviews {
7967         set n $nextviewnum
7968         incr nextviewnum
7969         set viewname($n) [lindex $v 0]
7970         set viewfiles($n) [lindex $v 1]
7971         set viewargs($n) [lindex $v 2]
7972         set viewperm($n) 1
7973         addviewmenu $n
7974     }
7975 }
7976 getcommits