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 rowchk
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
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
2004     set curview $n
2005     set selectedview $n
2006     .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
2007     .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
2008
2009     if {![info exists viewdata($n)]} {
2010         if {$selid ne {}} {
2011             set pending_select $selid
2012         }
2013         getcommits
2014         return
2015     }
2016
2017     set v $viewdata($n)
2018     set phase [lindex $v 0]
2019     set displayorder $vdisporder($n)
2020     set parentlist $vparentlist($n)
2021     set commitlisted $vcmitlisted($n)
2022     set rowidlist [lindex $v 1]
2023     if {$phase eq {}} {
2024         set numcommits [llength $displayorder]
2025     } else {
2026         set rowlaidout [lindex $v 2]
2027         set rowoptim [lindex $v 3]
2028         set numcommits [lindex $v 4]
2029         catch {unset rowchk}
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 rowchk
2707     global numcommits canvxmax canv
2708     global nextcolor
2709     global parentlist
2710     global colormap rowtextx
2711     global selectfirst
2712
2713     set numcommits 0
2714     set displayorder {}
2715     set commitlisted {}
2716     set parentlist {}
2717     set nextcolor 0
2718     set rowidlist {{}}
2719     catch {unset rowchk}
2720     set rowlaidout 0
2721     set rowoptim 0
2722     set canvxmax [$canv cget -width]
2723     catch {unset colormap}
2724     catch {unset rowtextx}
2725     set selectfirst 1
2726 }
2727
2728 proc setcanvscroll {} {
2729     global canv canv2 canv3 numcommits linespc canvxmax canvy0
2730
2731     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2732     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2733     $canv2 conf -scrollregion [list 0 0 0 $ymax]
2734     $canv3 conf -scrollregion [list 0 0 0 $ymax]
2735 }
2736
2737 proc visiblerows {} {
2738     global canv numcommits linespc
2739
2740     set ymax [lindex [$canv cget -scrollregion] 3]
2741     if {$ymax eq {} || $ymax == 0} return
2742     set f [$canv yview]
2743     set y0 [expr {int([lindex $f 0] * $ymax)}]
2744     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2745     if {$r0 < 0} {
2746         set r0 0
2747     }
2748     set y1 [expr {int([lindex $f 1] * $ymax)}]
2749     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2750     if {$r1 >= $numcommits} {
2751         set r1 [expr {$numcommits - 1}]
2752     }
2753     return [list $r0 $r1]
2754 }
2755
2756 proc layoutmore {tmax allread} {
2757     global rowlaidout rowoptim commitidx numcommits optim_delay
2758     global uparrowlen curview rowidlist
2759
2760     set showlast 0
2761     set showdelay $optim_delay
2762     set optdelay [expr {$uparrowlen + 1}]
2763     while {1} {
2764         if {$rowoptim - $showdelay > $numcommits} {
2765             showstuff [expr {$rowoptim - $showdelay}] $showlast
2766         } elseif {$rowlaidout - $optdelay > $rowoptim} {
2767             set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
2768             if {$nr > 100} {
2769                 set nr 100
2770             }
2771             optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
2772             incr rowoptim $nr
2773         } elseif {$commitidx($curview) > $rowlaidout} {
2774             set nr [expr {$commitidx($curview) - $rowlaidout}]
2775             # may need to increase this threshold if uparrowlen or
2776             # mingaplen are increased...
2777             if {$nr > 200} {
2778                 set nr 200
2779             }
2780             set row $rowlaidout
2781             set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
2782             if {$rowlaidout == $row} {
2783                 return 0
2784             }
2785         } elseif {$allread} {
2786             set optdelay 0
2787             set nrows $commitidx($curview)
2788             if {[lindex $rowidlist $nrows] ne {}} {
2789                 layouttail
2790                 set rowlaidout $commitidx($curview)
2791             } elseif {$rowoptim == $nrows} {
2792                 set showdelay 0
2793                 set showlast 1
2794                 if {$numcommits == $nrows} {
2795                     return 0
2796                 }
2797             }
2798         } else {
2799             return 0
2800         }
2801         if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
2802             return 1
2803         }
2804     }
2805 }
2806
2807 proc showstuff {canshow last} {
2808     global numcommits commitrow pending_select selectedline curview
2809     global lookingforhead mainheadid displayorder selectfirst
2810     global lastscrollset commitinterest
2811
2812     if {$numcommits == 0} {
2813         global phase
2814         set phase "incrdraw"
2815         allcanvs delete all
2816     }
2817     for {set l $numcommits} {$l < $canshow} {incr l} {
2818         set id [lindex $displayorder $l]
2819         if {[info exists commitinterest($id)]} {
2820             foreach script $commitinterest($id) {
2821                 eval [string map [list "%I" $id] $script]
2822             }
2823             unset commitinterest($id)
2824         }
2825     }
2826     set r0 $numcommits
2827     set prev $numcommits
2828     set numcommits $canshow
2829     set t [clock clicks -milliseconds]
2830     if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2831         set lastscrollset $t
2832         setcanvscroll
2833     }
2834     set rows [visiblerows]
2835     set r1 [lindex $rows 1]
2836     if {$r1 >= $canshow} {
2837         set r1 [expr {$canshow - 1}]
2838     }
2839     if {$r0 <= $r1} {
2840         drawcommits $r0 $r1
2841     }
2842     if {[info exists pending_select] &&
2843         [info exists commitrow($curview,$pending_select)] &&
2844         $commitrow($curview,$pending_select) < $numcommits} {
2845         selectline $commitrow($curview,$pending_select) 1
2846     }
2847     if {$selectfirst} {
2848         if {[info exists selectedline] || [info exists pending_select]} {
2849             set selectfirst 0
2850         } else {
2851             set l [first_real_row]
2852             selectline $l 1
2853             set selectfirst 0
2854         }
2855     }
2856     if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
2857         && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2858         set lookingforhead 0
2859         dodiffindex
2860     }
2861 }
2862
2863 proc doshowlocalchanges {} {
2864     global lookingforhead curview mainheadid phase commitrow
2865
2866     if {[info exists commitrow($curview,$mainheadid)] &&
2867         ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2868         dodiffindex
2869     } elseif {$phase ne {}} {
2870         set lookingforhead 1
2871     }
2872 }
2873
2874 proc dohidelocalchanges {} {
2875     global lookingforhead localfrow localirow lserial
2876
2877     set lookingforhead 0
2878     if {$localfrow >= 0} {
2879         removerow $localfrow
2880         set localfrow -1
2881         if {$localirow > 0} {
2882             incr localirow -1
2883         }
2884     }
2885     if {$localirow >= 0} {
2886         removerow $localirow
2887         set localirow -1
2888     }
2889     incr lserial
2890 }
2891
2892 # spawn off a process to do git diff-index --cached HEAD
2893 proc dodiffindex {} {
2894     global localirow localfrow lserial
2895
2896     incr lserial
2897     set localfrow -1
2898     set localirow -1
2899     set fd [open "|git diff-index --cached HEAD" r]
2900     fconfigure $fd -blocking 0
2901     filerun $fd [list readdiffindex $fd $lserial]
2902 }
2903
2904 proc readdiffindex {fd serial} {
2905     global localirow commitrow mainheadid nullid2 curview
2906     global commitinfo commitdata lserial
2907
2908     set isdiff 1
2909     if {[gets $fd line] < 0} {
2910         if {![eof $fd]} {
2911             return 1
2912         }
2913         set isdiff 0
2914     }
2915     # we only need to see one line and we don't really care what it says...
2916     close $fd
2917
2918     # now see if there are any local changes not checked in to the index
2919     if {$serial == $lserial} {
2920         set fd [open "|git diff-files" r]
2921         fconfigure $fd -blocking 0
2922         filerun $fd [list readdifffiles $fd $serial]
2923     }
2924
2925     if {$isdiff && $serial == $lserial && $localirow == -1} {
2926         # add the line for the changes in the index to the graph
2927         set localirow $commitrow($curview,$mainheadid)
2928         set hl "Local changes checked in to index but not committed"
2929         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
2930         set commitdata($nullid2) "\n    $hl\n"
2931         insertrow $localirow $nullid2
2932     }
2933     return 0
2934 }
2935
2936 proc readdifffiles {fd serial} {
2937     global localirow localfrow commitrow mainheadid nullid curview
2938     global commitinfo commitdata lserial
2939
2940     set isdiff 1
2941     if {[gets $fd line] < 0} {
2942         if {![eof $fd]} {
2943             return 1
2944         }
2945         set isdiff 0
2946     }
2947     # we only need to see one line and we don't really care what it says...
2948     close $fd
2949
2950     if {$isdiff && $serial == $lserial && $localfrow == -1} {
2951         # add the line for the local diff to the graph
2952         if {$localirow >= 0} {
2953             set localfrow $localirow
2954             incr localirow
2955         } else {
2956             set localfrow $commitrow($curview,$mainheadid)
2957         }
2958         set hl "Local uncommitted changes, not checked in to index"
2959         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
2960         set commitdata($nullid) "\n    $hl\n"
2961         insertrow $localfrow $nullid
2962     }
2963     return 0
2964 }
2965
2966 proc layoutrows {row endrow last} {
2967     global rowidlist displayorder
2968     global uparrowlen downarrowlen maxwidth mingaplen
2969     global children parentlist
2970     global commitidx curview
2971     global rowchk
2972
2973     set idlist [lindex $rowidlist $row]
2974     while {$row < $endrow} {
2975         set id [lindex $displayorder $row]
2976         if {1} {
2977             if {!$last &&
2978                 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2979             for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2980                 set i [lindex $idlist $x]
2981                 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2982                     set r [usedinrange $i [expr {$row - $downarrowlen}] \
2983                                [expr {$row + $uparrowlen + $mingaplen}]]
2984                     if {$r == 0} {
2985                         set idlist [lreplace $idlist $x $x]
2986                         continue
2987                     }
2988                     set rowchk($i) [expr {$row + $r}]
2989                 }
2990             }
2991             lset rowidlist $row $idlist
2992         }
2993         set oldolds {}
2994         set newolds {}
2995         foreach p [lindex $parentlist $row] {
2996             # is id the first child of this parent?
2997             if {$id eq [lindex $children($curview,$p) 0]} {
2998                 lappend newolds $p
2999             } elseif {[lsearch -exact $idlist $p] < 0} {
3000                 lappend oldolds $p
3001             }
3002         }
3003         set col [lsearch -exact $idlist $id]
3004         if {$col < 0} {
3005             set col [idcol $idlist $id]
3006             set idlist [linsert $idlist $col $id]
3007             lset rowidlist $row $idlist
3008             if {$children($curview,$id) ne {}} {
3009                 makeuparrow $id $row $col
3010             }
3011         }
3012         incr row
3013         set idlist [lreplace $idlist $col $col]
3014         set x $col
3015         foreach i $newolds {
3016             set x [idcol $idlist $i $x]
3017             set idlist [linsert $idlist $x $i]
3018         }
3019         foreach oid $oldolds {
3020             set x [idcol $idlist $oid $x]
3021             set idlist [linsert $idlist $x $oid]
3022             makeuparrow $oid $row $x
3023         }
3024         lappend rowidlist $idlist
3025     }
3026     return $row
3027 }
3028
3029 proc addextraid {id row} {
3030     global displayorder commitrow commitinfo
3031     global commitidx commitlisted
3032     global parentlist children curview
3033
3034     incr commitidx($curview)
3035     lappend displayorder $id
3036     lappend commitlisted 0
3037     lappend parentlist {}
3038     set commitrow($curview,$id) $row
3039     readcommit $id
3040     if {![info exists commitinfo($id)]} {
3041         set commitinfo($id) {"No commit information available"}
3042     }
3043     if {![info exists children($curview,$id)]} {
3044         set children($curview,$id) {}
3045     }
3046 }
3047
3048 proc layouttail {} {
3049     global rowidlist commitidx curview
3050
3051     set row $commitidx($curview)
3052     set idlist [lindex $rowidlist $row]
3053     while {$idlist ne {}} {
3054         set col [expr {[llength $idlist] - 1}]
3055         set id [lindex $idlist $col]
3056         addextraid $id $row
3057         incr row
3058         set idlist [lreplace $idlist $col $col]
3059         lappend rowidlist $idlist
3060     }
3061 }
3062
3063 proc insert_pad {row col npad} {
3064     global rowidlist
3065
3066     set pad [ntimes $npad {}]
3067     set idlist [lindex $rowidlist $row]
3068     set bef [lrange $idlist 0 [expr {$col - 1}]]
3069     set aft [lrange $idlist $col end]
3070     set i [lsearch -exact $aft {}]
3071     if {$i > 0} {
3072         set aft [lreplace $aft $i $i]
3073     }
3074     lset rowidlist $row [concat $bef $pad $aft]
3075 }
3076
3077 proc optimize_rows {row col endrow} {
3078     global rowidlist displayorder curview children
3079
3080     if {$row < 1} {
3081         set row 1
3082     }
3083     set idlist [lindex $rowidlist [expr {$row - 1}]]
3084     if {$row >= 2} {
3085         set previdlist [lindex $rowidlist [expr {$row - 2}]]
3086     } else {
3087         set previdlist {}
3088     }
3089     for {} {$row < $endrow} {incr row} {
3090         set pprevidlist $previdlist
3091         set previdlist $idlist
3092         set idlist [lindex $rowidlist $row]
3093         set haspad 0
3094         set y0 [expr {$row - 1}]
3095         set ym [expr {$row - 2}]
3096         set x0 -1
3097         set xm -1
3098         for {} {$col < [llength $idlist]} {incr col} {
3099             set id [lindex $idlist $col]
3100             if {[lindex $previdlist $col] eq $id} continue
3101             if {$id eq {}} {
3102                 set haspad 1
3103                 continue
3104             }
3105             set x0 [lsearch -exact $previdlist $id]
3106             if {$x0 < 0} continue
3107             set z [expr {$x0 - $col}]
3108             set isarrow 0
3109             set z0 {}
3110             if {$ym >= 0} {
3111                 set xm [lsearch -exact $pprevidlist $id]
3112                 if {$xm >= 0} {
3113                     set z0 [expr {$xm - $x0}]
3114                 }
3115             }
3116             if {$z0 eq {}} {
3117                 # if row y0 is the first child of $id then it's not an arrow
3118                 if {[lindex $children($curview,$id) 0] ne
3119                     [lindex $displayorder $y0]} {
3120                     set isarrow 1
3121                 }
3122             }
3123             if {!$isarrow && $id ne [lindex $displayorder $row] &&
3124                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3125                 set isarrow 1
3126             }
3127             # Looking at lines from this row to the previous row,
3128             # make them go straight up if they end in an arrow on
3129             # the previous row; otherwise make them go straight up
3130             # or at 45 degrees.
3131             if {$z < -1 || ($z < 0 && $isarrow)} {
3132                 # Line currently goes left too much;
3133                 # insert pads in the previous row, then optimize it
3134                 set npad [expr {-1 - $z + $isarrow}]
3135                 insert_pad $y0 $x0 $npad
3136                 if {$y0 > 0} {
3137                     optimize_rows $y0 $x0 $row
3138                 }
3139                 set previdlist [lindex $rowidlist $y0]
3140                 set x0 [lsearch -exact $previdlist $id]
3141                 set z [expr {$x0 - $col}]
3142                 if {$z0 ne {}} {
3143                     set pprevidlist [lindex $rowidlist $ym]
3144                     set xm [lsearch -exact $pprevidlist $id]
3145                     set z0 [expr {$xm - $x0}]
3146                 }
3147             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3148                 # Line currently goes right too much;
3149                 # insert pads in this line
3150                 set npad [expr {$z - 1 + $isarrow}]
3151                 insert_pad $row $col $npad
3152                 set idlist [lindex $rowidlist $row]
3153                 incr col $npad
3154                 set z [expr {$x0 - $col}]
3155                 set haspad 1
3156             }
3157             if {$z0 eq {} && !$isarrow && $ym >= 0} {
3158                 # this line links to its first child on row $row-2
3159                 set id [lindex $displayorder $ym]
3160                 set xc [lsearch -exact $pprevidlist $id]
3161                 if {$xc >= 0} {
3162                     set z0 [expr {$xc - $x0}]
3163                 }
3164             }
3165             # avoid lines jigging left then immediately right
3166             if {$z0 ne {} && $z < 0 && $z0 > 0} {
3167                 insert_pad $y0 $x0 1
3168                 incr x0
3169                 optimize_rows $y0 $x0 $row
3170                 set previdlist [lindex $rowidlist $y0]
3171                 set pprevidlist [lindex $rowidlist $ym]
3172             }
3173         }
3174         if {!$haspad} {
3175             # Find the first column that doesn't have a line going right
3176             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3177                 set id [lindex $idlist $col]
3178                 if {$id eq {}} break
3179                 set x0 [lsearch -exact $previdlist $id]
3180                 if {$x0 < 0} {
3181                     # check if this is the link to the first child
3182                     set kid [lindex $displayorder $y0]
3183                     if {[lindex $children($curview,$id) 0] eq $kid} {
3184                         # it is, work out offset to child
3185                         set x0 [lsearch -exact $previdlist $kid]
3186                     }
3187                 }
3188                 if {$x0 <= $col} break
3189             }
3190             # Insert a pad at that column as long as it has a line and
3191             # isn't the last column
3192             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3193                 set idlist [linsert $idlist $col {}]
3194             }
3195         }
3196         lset rowidlist $row $idlist
3197         set col 0
3198     }
3199 }
3200
3201 proc xc {row col} {
3202     global canvx0 linespc
3203     return [expr {$canvx0 + $col * $linespc}]
3204 }
3205
3206 proc yc {row} {
3207     global canvy0 linespc
3208     return [expr {$canvy0 + $row * $linespc}]
3209 }
3210
3211 proc linewidth {id} {
3212     global thickerline lthickness
3213
3214     set wid $lthickness
3215     if {[info exists thickerline] && $id eq $thickerline} {
3216         set wid [expr {2 * $lthickness}]
3217     }
3218     return $wid
3219 }
3220
3221 proc rowranges {id} {
3222     global commitrow curview children uparrowlen downarrowlen
3223     global rowidlist
3224
3225     set kids $children($curview,$id)
3226     if {$kids eq {}} {
3227         return {}
3228     }
3229     set ret {}
3230     lappend kids $id
3231     foreach child $kids {
3232         if {![info exists commitrow($curview,$child)]} break
3233         set row $commitrow($curview,$child)
3234         if {![info exists prev]} {
3235             lappend ret [expr {$row + 1}]
3236         } else {
3237             if {$row <= $prevrow} {
3238                 puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3239             }
3240             # see if the line extends the whole way from prevrow to row
3241             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3242                 [lsearch -exact [lindex $rowidlist \
3243                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3244                 # it doesn't, see where it ends
3245                 set r [expr {$prevrow + $downarrowlen}]
3246                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3247                     while {[incr r -1] > $prevrow &&
3248                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3249                 } else {
3250                     while {[incr r] <= $row &&
3251                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3252                     incr r -1
3253                 }
3254                 lappend ret $r
3255                 # see where it starts up again
3256                 set r [expr {$row - $uparrowlen}]
3257                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3258                     while {[incr r] < $row &&
3259                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3260                 } else {
3261                     while {[incr r -1] >= $prevrow &&
3262                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3263                     incr r
3264                 }
3265                 lappend ret $r
3266             }
3267         }
3268         if {$child eq $id} {
3269             lappend ret $row
3270         }
3271         set prev $id
3272         set prevrow $row
3273     }
3274     return $ret
3275 }
3276
3277 proc drawlineseg {id row endrow arrowlow} {
3278     global rowidlist displayorder iddrawn linesegs
3279     global canv colormap linespc curview maxlinelen parentlist
3280
3281     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3282     set le [expr {$row + 1}]
3283     set arrowhigh 1
3284     while {1} {
3285         set c [lsearch -exact [lindex $rowidlist $le] $id]
3286         if {$c < 0} {
3287             incr le -1
3288             break
3289         }
3290         lappend cols $c
3291         set x [lindex $displayorder $le]
3292         if {$x eq $id} {
3293             set arrowhigh 0
3294             break
3295         }
3296         if {[info exists iddrawn($x)] || $le == $endrow} {
3297             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3298             if {$c >= 0} {
3299                 lappend cols $c
3300                 set arrowhigh 0
3301             }
3302             break
3303         }
3304         incr le
3305     }
3306     if {$le <= $row} {
3307         return $row
3308     }
3309
3310     set lines {}
3311     set i 0
3312     set joinhigh 0
3313     if {[info exists linesegs($id)]} {
3314         set lines $linesegs($id)
3315         foreach li $lines {
3316             set r0 [lindex $li 0]
3317             if {$r0 > $row} {
3318                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3319                     set joinhigh 1
3320                 }
3321                 break
3322             }
3323             incr i
3324         }
3325     }
3326     set joinlow 0
3327     if {$i > 0} {
3328         set li [lindex $lines [expr {$i-1}]]
3329         set r1 [lindex $li 1]
3330         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3331             set joinlow 1
3332         }
3333     }
3334
3335     set x [lindex $cols [expr {$le - $row}]]
3336     set xp [lindex $cols [expr {$le - 1 - $row}]]
3337     set dir [expr {$xp - $x}]
3338     if {$joinhigh} {
3339         set ith [lindex $lines $i 2]
3340         set coords [$canv coords $ith]
3341         set ah [$canv itemcget $ith -arrow]
3342         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3343         set x2 [lindex $cols [expr {$le + 1 - $row}]]
3344         if {$x2 ne {} && $x - $x2 == $dir} {
3345             set coords [lrange $coords 0 end-2]
3346         }
3347     } else {
3348         set coords [list [xc $le $x] [yc $le]]
3349     }
3350     if {$joinlow} {
3351         set itl [lindex $lines [expr {$i-1}] 2]
3352         set al [$canv itemcget $itl -arrow]
3353         set arrowlow [expr {$al eq "last" || $al eq "both"}]
3354     } elseif {$arrowlow} {
3355         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3356             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3357             set arrowlow 0
3358         }
3359     }
3360     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3361     for {set y $le} {[incr y -1] > $row} {} {
3362         set x $xp
3363         set xp [lindex $cols [expr {$y - 1 - $row}]]
3364         set ndir [expr {$xp - $x}]
3365         if {$dir != $ndir || $xp < 0} {
3366             lappend coords [xc $y $x] [yc $y]
3367         }
3368         set dir $ndir
3369     }
3370     if {!$joinlow} {
3371         if {$xp < 0} {
3372             # join parent line to first child
3373             set ch [lindex $displayorder $row]
3374             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3375             if {$xc < 0} {
3376                 puts "oops: drawlineseg: child $ch not on row $row"
3377             } elseif {$xc != $x} {
3378                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3379                     set d [expr {int(0.5 * $linespc)}]
3380                     set x1 [xc $row $x]
3381                     if {$xc < $x} {
3382                         set x2 [expr {$x1 - $d}]
3383                     } else {
3384                         set x2 [expr {$x1 + $d}]
3385                     }
3386                     set y2 [yc $row]
3387                     set y1 [expr {$y2 + $d}]
3388                     lappend coords $x1 $y1 $x2 $y2
3389                 } elseif {$xc < $x - 1} {
3390                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
3391                 } elseif {$xc > $x + 1} {
3392                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
3393                 }
3394                 set x $xc
3395             }
3396             lappend coords [xc $row $x] [yc $row]
3397         } else {
3398             set xn [xc $row $xp]
3399             set yn [yc $row]
3400             lappend coords $xn $yn
3401         }
3402         if {!$joinhigh} {
3403             assigncolor $id
3404             set t [$canv create line $coords -width [linewidth $id] \
3405                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
3406             $canv lower $t
3407             bindline $t $id
3408             set lines [linsert $lines $i [list $row $le $t]]
3409         } else {
3410             $canv coords $ith $coords
3411             if {$arrow ne $ah} {
3412                 $canv itemconf $ith -arrow $arrow
3413             }
3414             lset lines $i 0 $row
3415         }
3416     } else {
3417         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3418         set ndir [expr {$xo - $xp}]
3419         set clow [$canv coords $itl]
3420         if {$dir == $ndir} {
3421             set clow [lrange $clow 2 end]
3422         }
3423         set coords [concat $coords $clow]
3424         if {!$joinhigh} {
3425             lset lines [expr {$i-1}] 1 $le
3426         } else {
3427             # coalesce two pieces
3428             $canv delete $ith
3429             set b [lindex $lines [expr {$i-1}] 0]
3430             set e [lindex $lines $i 1]
3431             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3432         }
3433         $canv coords $itl $coords
3434         if {$arrow ne $al} {
3435             $canv itemconf $itl -arrow $arrow
3436         }
3437     }
3438
3439     set linesegs($id) $lines
3440     return $le
3441 }
3442
3443 proc drawparentlinks {id row} {
3444     global rowidlist canv colormap curview parentlist
3445     global idpos linespc
3446
3447     set rowids [lindex $rowidlist $row]
3448     set col [lsearch -exact $rowids $id]
3449     if {$col < 0} return
3450     set olds [lindex $parentlist $row]
3451     set row2 [expr {$row + 1}]
3452     set x [xc $row $col]
3453     set y [yc $row]
3454     set y2 [yc $row2]
3455     set d [expr {int(0.5 * $linespc)}]
3456     set ymid [expr {$y + $d}]
3457     set ids [lindex $rowidlist $row2]
3458     # rmx = right-most X coord used
3459     set rmx 0
3460     foreach p $olds {
3461         set i [lsearch -exact $ids $p]
3462         if {$i < 0} {
3463             puts "oops, parent $p of $id not in list"
3464             continue
3465         }
3466         set x2 [xc $row2 $i]
3467         if {$x2 > $rmx} {
3468             set rmx $x2
3469         }
3470         set j [lsearch -exact $rowids $p]
3471         if {$j < 0} {
3472             # drawlineseg will do this one for us
3473             continue
3474         }
3475         assigncolor $p
3476         # should handle duplicated parents here...
3477         set coords [list $x $y]
3478         if {$i != $col} {
3479             # if attaching to a vertical segment, draw a smaller
3480             # slant for visual distinctness
3481             if {$i == $j} {
3482                 if {$i < $col} {
3483                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3484                 } else {
3485                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3486                 }
3487             } elseif {$i < $col && $i < $j} {
3488                 # segment slants towards us already
3489                 lappend coords [xc $row $j] $y
3490             } else {
3491                 if {$i < $col - 1} {
3492                     lappend coords [expr {$x2 + $linespc}] $y
3493                 } elseif {$i > $col + 1} {
3494                     lappend coords [expr {$x2 - $linespc}] $y
3495                 }
3496                 lappend coords $x2 $y2
3497             }
3498         } else {
3499             lappend coords $x2 $y2
3500         }
3501         set t [$canv create line $coords -width [linewidth $p] \
3502                    -fill $colormap($p) -tags lines.$p]
3503         $canv lower $t
3504         bindline $t $p
3505     }
3506     if {$rmx > [lindex $idpos($id) 1]} {
3507         lset idpos($id) 1 $rmx
3508         redrawtags $id
3509     }
3510 }
3511
3512 proc drawlines {id} {
3513     global canv
3514
3515     $canv itemconf lines.$id -width [linewidth $id]
3516 }
3517
3518 proc drawcmittext {id row col} {
3519     global linespc canv canv2 canv3 canvy0 fgcolor curview
3520     global commitlisted commitinfo rowidlist parentlist
3521     global rowtextx idpos idtags idheads idotherrefs
3522     global linehtag linentag linedtag
3523     global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
3524
3525     # listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
3526     set listed [lindex $commitlisted $row]
3527     if {$id eq $nullid} {
3528         set ofill red
3529     } elseif {$id eq $nullid2} {
3530         set ofill green
3531     } else {
3532         set ofill [expr {$listed != 0? "blue": "white"}]
3533     }
3534     set x [xc $row $col]
3535     set y [yc $row]
3536     set orad [expr {$linespc / 3}]
3537     if {$listed <= 1} {
3538         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3539                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3540                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3541     } elseif {$listed == 2} {
3542         # triangle pointing left for left-side commits
3543         set t [$canv create polygon \
3544                    [expr {$x - $orad}] $y \
3545                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3546                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3547                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3548     } else {
3549         # triangle pointing right for right-side commits
3550         set t [$canv create polygon \
3551                    [expr {$x + $orad - 1}] $y \
3552                    [expr {$x - $orad}] [expr {$y - $orad}] \
3553                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3554                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
3555     }
3556     $canv raise $t
3557     $canv bind $t <1> {selcanvline {} %x %y}
3558     set rmx [llength [lindex $rowidlist $row]]
3559     set olds [lindex $parentlist $row]
3560     if {$olds ne {}} {
3561         set nextids [lindex $rowidlist [expr {$row + 1}]]
3562         foreach p $olds {
3563             set i [lsearch -exact $nextids $p]
3564             if {$i > $rmx} {
3565                 set rmx $i
3566             }
3567         }
3568     }
3569     set xt [xc $row $rmx]
3570     set rowtextx($row) $xt
3571     set idpos($id) [list $x $xt $y]
3572     if {[info exists idtags($id)] || [info exists idheads($id)]
3573         || [info exists idotherrefs($id)]} {
3574         set xt [drawtags $id $x $xt $y]
3575     }
3576     set headline [lindex $commitinfo($id) 0]
3577     set name [lindex $commitinfo($id) 1]
3578     set date [lindex $commitinfo($id) 2]
3579     set date [formatdate $date]
3580     set font $mainfont
3581     set nfont $mainfont
3582     set isbold [ishighlighted $row]
3583     if {$isbold > 0} {
3584         lappend boldrows $row
3585         lappend font bold
3586         if {$isbold > 1} {
3587             lappend boldnamerows $row
3588             lappend nfont bold
3589         }
3590     }
3591     set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3592                             -text $headline -font $font -tags text]
3593     $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3594     set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3595                             -text $name -font $nfont -tags text]
3596     set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3597                             -text $date -font $mainfont -tags text]
3598     set xr [expr {$xt + [font measure $mainfont $headline]}]
3599     if {$xr > $canvxmax} {
3600         set canvxmax $xr
3601         setcanvscroll
3602     }
3603 }
3604
3605 proc drawcmitrow {row} {
3606     global displayorder rowidlist
3607     global iddrawn markingmatches
3608     global commitinfo parentlist numcommits
3609     global filehighlight fhighlights findstring nhighlights
3610     global hlview vhighlights
3611     global highlight_related rhighlights
3612
3613     if {$row >= $numcommits} return
3614
3615     set id [lindex $displayorder $row]
3616     if {[info exists hlview] && ![info exists vhighlights($row)]} {
3617         askvhighlight $row $id
3618     }
3619     if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3620         askfilehighlight $row $id
3621     }
3622     if {$findstring ne {} && ![info exists nhighlights($row)]} {
3623         askfindhighlight $row $id
3624     }
3625     if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3626         askrelhighlight $row $id
3627     }
3628     if {![info exists iddrawn($id)]} {
3629         set col [lsearch -exact [lindex $rowidlist $row] $id]
3630         if {$col < 0} {
3631             puts "oops, row $row id $id not in list"
3632             return
3633         }
3634         if {![info exists commitinfo($id)]} {
3635             getcommit $id
3636         }
3637         assigncolor $id
3638         drawcmittext $id $row $col
3639         set iddrawn($id) 1
3640     }
3641     if {$markingmatches} {
3642         markrowmatches $row $id
3643     }
3644 }
3645
3646 proc drawcommits {row {endrow {}}} {
3647     global numcommits iddrawn displayorder curview
3648     global parentlist rowidlist
3649
3650     if {$row < 0} {
3651         set row 0
3652     }
3653     if {$endrow eq {}} {
3654         set endrow $row
3655     }
3656     if {$endrow >= $numcommits} {
3657         set endrow [expr {$numcommits - 1}]
3658     }
3659
3660     # make the lines join to already-drawn rows either side
3661     set r [expr {$row - 1}]
3662     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3663         set r $row
3664     }
3665     set er [expr {$endrow + 1}]
3666     if {$er >= $numcommits ||
3667         ![info exists iddrawn([lindex $displayorder $er])]} {
3668         set er $endrow
3669     }
3670     for {} {$r <= $er} {incr r} {
3671         set id [lindex $displayorder $r]
3672         set wasdrawn [info exists iddrawn($id)]
3673         drawcmitrow $r
3674         if {$r == $er} break
3675         set nextid [lindex $displayorder [expr {$r + 1}]]
3676         if {$wasdrawn && [info exists iddrawn($nextid)]} {
3677             catch {unset prevlines}
3678             continue
3679         }
3680         drawparentlinks $id $r
3681
3682         if {[info exists lineends($r)]} {
3683             foreach lid $lineends($r) {
3684                 unset prevlines($lid)
3685             }
3686         }
3687         set rowids [lindex $rowidlist $r]
3688         foreach lid $rowids {
3689             if {$lid eq {}} continue
3690             if {$lid eq $id} {
3691                 # see if this is the first child of any of its parents
3692                 foreach p [lindex $parentlist $r] {
3693                     if {[lsearch -exact $rowids $p] < 0} {
3694                         # make this line extend up to the child
3695                         set le [drawlineseg $p $r $er 0]
3696                         lappend lineends($le) $p
3697                         set prevlines($p) 1
3698                     }
3699                 }
3700             } elseif {![info exists prevlines($lid)]} {
3701                 set le [drawlineseg $lid $r $er 1]
3702                 lappend lineends($le) $lid
3703                 set prevlines($lid) 1
3704             }
3705         }
3706     }
3707 }
3708
3709 proc drawfrac {f0 f1} {
3710     global canv linespc
3711
3712     set ymax [lindex [$canv cget -scrollregion] 3]
3713     if {$ymax eq {} || $ymax == 0} return
3714     set y0 [expr {int($f0 * $ymax)}]
3715     set row [expr {int(($y0 - 3) / $linespc) - 1}]
3716     set y1 [expr {int($f1 * $ymax)}]
3717     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3718     drawcommits $row $endrow
3719 }
3720
3721 proc drawvisible {} {
3722     global canv
3723     eval drawfrac [$canv yview]
3724 }
3725
3726 proc clear_display {} {
3727     global iddrawn linesegs
3728     global vhighlights fhighlights nhighlights rhighlights
3729
3730     allcanvs delete all
3731     catch {unset iddrawn}
3732     catch {unset linesegs}
3733     catch {unset vhighlights}
3734     catch {unset fhighlights}
3735     catch {unset nhighlights}
3736     catch {unset rhighlights}
3737 }
3738
3739 proc findcrossings {id} {
3740     global rowidlist parentlist numcommits displayorder
3741
3742     set cross {}
3743     set ccross {}
3744     foreach {s e} [rowranges $id] {
3745         if {$e >= $numcommits} {
3746             set e [expr {$numcommits - 1}]
3747         }
3748         if {$e <= $s} continue
3749         for {set row $e} {[incr row -1] >= $s} {} {
3750             set x [lsearch -exact [lindex $rowidlist $row] $id]
3751             if {$x < 0} break
3752             set olds [lindex $parentlist $row]
3753             set kid [lindex $displayorder $row]
3754             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3755             if {$kidx < 0} continue
3756             set nextrow [lindex $rowidlist [expr {$row + 1}]]
3757             foreach p $olds {
3758                 set px [lsearch -exact $nextrow $p]
3759                 if {$px < 0} continue
3760                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3761                     if {[lsearch -exact $ccross $p] >= 0} continue
3762                     if {$x == $px + ($kidx < $px? -1: 1)} {
3763                         lappend ccross $p
3764                     } elseif {[lsearch -exact $cross $p] < 0} {
3765                         lappend cross $p
3766                     }
3767                 }
3768             }
3769         }
3770     }
3771     return [concat $ccross {{}} $cross]
3772 }
3773
3774 proc assigncolor {id} {
3775     global colormap colors nextcolor
3776     global commitrow parentlist children children curview
3777
3778     if {[info exists colormap($id)]} return
3779     set ncolors [llength $colors]
3780     if {[info exists children($curview,$id)]} {
3781         set kids $children($curview,$id)
3782     } else {
3783         set kids {}
3784     }
3785     if {[llength $kids] == 1} {
3786         set child [lindex $kids 0]
3787         if {[info exists colormap($child)]
3788             && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3789             set colormap($id) $colormap($child)
3790             return
3791         }
3792     }
3793     set badcolors {}
3794     set origbad {}
3795     foreach x [findcrossings $id] {
3796         if {$x eq {}} {
3797             # delimiter between corner crossings and other crossings
3798             if {[llength $badcolors] >= $ncolors - 1} break
3799             set origbad $badcolors
3800         }
3801         if {[info exists colormap($x)]
3802             && [lsearch -exact $badcolors $colormap($x)] < 0} {
3803             lappend badcolors $colormap($x)
3804         }
3805     }
3806     if {[llength $badcolors] >= $ncolors} {
3807         set badcolors $origbad
3808     }
3809     set origbad $badcolors
3810     if {[llength $badcolors] < $ncolors - 1} {
3811         foreach child $kids {
3812             if {[info exists colormap($child)]
3813                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3814                 lappend badcolors $colormap($child)
3815             }
3816             foreach p [lindex $parentlist $commitrow($curview,$child)] {
3817                 if {[info exists colormap($p)]
3818                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
3819                     lappend badcolors $colormap($p)
3820                 }
3821             }
3822         }
3823         if {[llength $badcolors] >= $ncolors} {
3824             set badcolors $origbad
3825         }
3826     }
3827     for {set i 0} {$i <= $ncolors} {incr i} {
3828         set c [lindex $colors $nextcolor]
3829         if {[incr nextcolor] >= $ncolors} {
3830             set nextcolor 0
3831         }
3832         if {[lsearch -exact $badcolors $c]} break
3833     }
3834     set colormap($id) $c
3835 }
3836
3837 proc bindline {t id} {
3838     global canv
3839
3840     $canv bind $t <Enter> "lineenter %x %y $id"
3841     $canv bind $t <Motion> "linemotion %x %y $id"
3842     $canv bind $t <Leave> "lineleave $id"
3843     $canv bind $t <Button-1> "lineclick %x %y $id 1"
3844 }
3845
3846 proc drawtags {id x xt y1} {
3847     global idtags idheads idotherrefs mainhead
3848     global linespc lthickness
3849     global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3850
3851     set marks {}
3852     set ntags 0
3853     set nheads 0
3854     if {[info exists idtags($id)]} {
3855         set marks $idtags($id)
3856         set ntags [llength $marks]
3857     }
3858     if {[info exists idheads($id)]} {
3859         set marks [concat $marks $idheads($id)]
3860         set nheads [llength $idheads($id)]
3861     }
3862     if {[info exists idotherrefs($id)]} {
3863         set marks [concat $marks $idotherrefs($id)]
3864     }
3865     if {$marks eq {}} {
3866         return $xt
3867     }
3868
3869     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3870     set yt [expr {$y1 - 0.5 * $linespc}]
3871     set yb [expr {$yt + $linespc - 1}]
3872     set xvals {}
3873     set wvals {}
3874     set i -1
3875     foreach tag $marks {
3876         incr i
3877         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3878             set wid [font measure [concat $mainfont bold] $tag]
3879         } else {
3880             set wid [font measure $mainfont $tag]
3881         }
3882         lappend xvals $xt
3883         lappend wvals $wid
3884         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3885     }
3886     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3887                -width $lthickness -fill black -tags tag.$id]
3888     $canv lower $t
3889     foreach tag $marks x $xvals wid $wvals {
3890         set xl [expr {$x + $delta}]
3891         set xr [expr {$x + $delta + $wid + $lthickness}]
3892         set font $mainfont
3893         if {[incr ntags -1] >= 0} {
3894             # draw a tag
3895             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3896                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3897                        -width 1 -outline black -fill yellow -tags tag.$id]
3898             $canv bind $t <1> [list showtag $tag 1]
3899             set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3900         } else {
3901             # draw a head or other ref
3902             if {[incr nheads -1] >= 0} {
3903                 set col green
3904                 if {$tag eq $mainhead} {
3905                     lappend font bold
3906                 }
3907             } else {
3908                 set col "#ddddff"
3909             }
3910             set xl [expr {$xl - $delta/2}]
3911             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3912                 -width 1 -outline black -fill $col -tags tag.$id
3913             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3914                 set rwid [font measure $mainfont $remoteprefix]
3915                 set xi [expr {$x + 1}]
3916                 set yti [expr {$yt + 1}]
3917                 set xri [expr {$x + $rwid}]
3918                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3919                         -width 0 -fill "#ffddaa" -tags tag.$id
3920             }
3921         }
3922         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3923                    -font $font -tags [list tag.$id text]]
3924         if {$ntags >= 0} {
3925             $canv bind $t <1> [list showtag $tag 1]
3926         } elseif {$nheads >= 0} {
3927             $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3928         }
3929     }
3930     return $xt
3931 }
3932
3933 proc xcoord {i level ln} {
3934     global canvx0 xspc1 xspc2
3935
3936     set x [expr {$canvx0 + $i * $xspc1($ln)}]
3937     if {$i > 0 && $i == $level} {
3938         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3939     } elseif {$i > $level} {
3940         set x [expr {$x + $xspc2 - $xspc1($ln)}]
3941     }
3942     return $x
3943 }
3944
3945 proc show_status {msg} {
3946     global canv mainfont fgcolor
3947
3948     clear_display
3949     $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3950         -tags text -fill $fgcolor
3951 }
3952
3953 # Insert a new commit as the child of the commit on row $row.
3954 # The new commit will be displayed on row $row and the commits
3955 # on that row and below will move down one row.
3956 proc insertrow {row newcmit} {
3957     global displayorder parentlist commitlisted children
3958     global commitrow curview rowidlist numcommits
3959     global rowlaidout rowoptim numcommits
3960     global selectedline rowchk commitidx
3961
3962     if {$row >= $numcommits} {
3963         puts "oops, inserting new row $row but only have $numcommits rows"
3964         return
3965     }
3966     set p [lindex $displayorder $row]
3967     set displayorder [linsert $displayorder $row $newcmit]
3968     set parentlist [linsert $parentlist $row $p]
3969     set kids $children($curview,$p)
3970     lappend kids $newcmit
3971     set children($curview,$p) $kids
3972     set children($curview,$newcmit) {}
3973     set commitlisted [linsert $commitlisted $row 1]
3974     set l [llength $displayorder]
3975     for {set r $row} {$r < $l} {incr r} {
3976         set id [lindex $displayorder $r]
3977         set commitrow($curview,$id) $r
3978     }
3979     incr commitidx($curview)
3980
3981     set idlist [lindex $rowidlist $row]
3982     if {[llength $kids] == 1} {
3983         set col [lsearch -exact $idlist $p]
3984         lset idlist $col $newcmit
3985     } else {
3986         set col [llength $idlist]
3987         lappend idlist $newcmit
3988     }
3989     set rowidlist [linsert $rowidlist $row $idlist]
3990
3991     catch {unset rowchk}
3992
3993     incr rowlaidout
3994     incr rowoptim
3995     incr numcommits
3996
3997     if {[info exists selectedline] && $selectedline >= $row} {
3998         incr selectedline
3999     }
4000     redisplay
4001 }
4002
4003 # Remove a commit that was inserted with insertrow on row $row.
4004 proc removerow {row} {
4005     global displayorder parentlist commitlisted children
4006     global commitrow curview rowidlist numcommits
4007     global rowlaidout rowoptim numcommits
4008     global linesegends selectedline rowchk commitidx
4009
4010     if {$row >= $numcommits} {
4011         puts "oops, removing row $row but only have $numcommits rows"
4012         return
4013     }
4014     set rp1 [expr {$row + 1}]
4015     set id [lindex $displayorder $row]
4016     set p [lindex $parentlist $row]
4017     set displayorder [lreplace $displayorder $row $row]
4018     set parentlist [lreplace $parentlist $row $row]
4019     set commitlisted [lreplace $commitlisted $row $row]
4020     set kids $children($curview,$p)
4021     set i [lsearch -exact $kids $id]
4022     if {$i >= 0} {
4023         set kids [lreplace $kids $i $i]
4024         set children($curview,$p) $kids
4025     }
4026     set l [llength $displayorder]
4027     for {set r $row} {$r < $l} {incr r} {
4028         set id [lindex $displayorder $r]
4029         set commitrow($curview,$id) $r
4030     }
4031     incr commitidx($curview) -1
4032
4033     set rowidlist [lreplace $rowidlist $row $row]
4034
4035     catch {unset rowchk}
4036
4037     incr rowlaidout -1
4038     incr rowoptim -1
4039     incr numcommits -1
4040
4041     if {[info exists selectedline] && $selectedline > $row} {
4042         incr selectedline -1
4043     }
4044     redisplay
4045 }
4046
4047 # Don't change the text pane cursor if it is currently the hand cursor,
4048 # showing that we are over a sha1 ID link.
4049 proc settextcursor {c} {
4050     global ctext curtextcursor
4051
4052     if {[$ctext cget -cursor] == $curtextcursor} {
4053         $ctext config -cursor $c
4054     }
4055     set curtextcursor $c
4056 }
4057
4058 proc nowbusy {what} {
4059     global isbusy
4060
4061     if {[array names isbusy] eq {}} {
4062         . config -cursor watch
4063         settextcursor watch
4064     }
4065     set isbusy($what) 1
4066 }
4067
4068 proc notbusy {what} {
4069     global isbusy maincursor textcursor
4070
4071     catch {unset isbusy($what)}
4072     if {[array names isbusy] eq {}} {
4073         . config -cursor $maincursor
4074         settextcursor $textcursor
4075     }
4076 }
4077
4078 proc findmatches {f} {
4079     global findtype findstring
4080     if {$findtype == "Regexp"} {
4081         set matches [regexp -indices -all -inline $findstring $f]
4082     } else {
4083         set fs $findstring
4084         if {$findtype == "IgnCase"} {
4085             set f [string tolower $f]
4086             set fs [string tolower $fs]
4087         }
4088         set matches {}
4089         set i 0
4090         set l [string length $fs]
4091         while {[set j [string first $fs $f $i]] >= 0} {
4092             lappend matches [list $j [expr {$j+$l-1}]]
4093             set i [expr {$j + $l}]
4094         }
4095     }
4096     return $matches
4097 }
4098
4099 proc dofind {{rev 0}} {
4100     global findstring findstartline findcurline selectedline numcommits
4101
4102     unmarkmatches
4103     cancel_next_highlight
4104     focus .
4105     if {$findstring eq {} || $numcommits == 0} return
4106     if {![info exists selectedline]} {
4107         set findstartline [lindex [visiblerows] $rev]
4108     } else {
4109         set findstartline $selectedline
4110     }
4111     set findcurline $findstartline
4112     nowbusy finding
4113     if {!$rev} {
4114         run findmore
4115     } else {
4116         if {$findcurline == 0} {
4117             set findcurline $numcommits
4118         }
4119         incr findcurline -1
4120         run findmorerev
4121     }
4122 }
4123
4124 proc findnext {restart} {
4125     global findcurline
4126     if {![info exists findcurline]} {
4127         if {$restart} {
4128             dofind
4129         } else {
4130             bell
4131         }
4132     } else {
4133         run findmore
4134         nowbusy finding
4135     }
4136 }
4137
4138 proc findprev {} {
4139     global findcurline
4140     if {![info exists findcurline]} {
4141         dofind 1
4142     } else {
4143         run findmorerev
4144         nowbusy finding
4145     }
4146 }
4147
4148 proc findmore {} {
4149     global commitdata commitinfo numcommits findstring findpattern findloc
4150     global findstartline findcurline displayorder
4151
4152     set fldtypes {Headline Author Date Committer CDate Comments}
4153     set l [expr {$findcurline + 1}]
4154     if {$l >= $numcommits} {
4155         set l 0
4156     }
4157     if {$l <= $findstartline} {
4158         set lim [expr {$findstartline + 1}]
4159     } else {
4160         set lim $numcommits
4161     }
4162     if {$lim - $l > 500} {
4163         set lim [expr {$l + 500}]
4164     }
4165     set last 0
4166     for {} {$l < $lim} {incr l} {
4167         set id [lindex $displayorder $l]
4168         # shouldn't happen unless git log doesn't give all the commits...
4169         if {![info exists commitdata($id)]} continue
4170         if {![doesmatch $commitdata($id)]} continue
4171         if {![info exists commitinfo($id)]} {
4172             getcommit $id
4173         }
4174         set info $commitinfo($id)
4175         foreach f $info ty $fldtypes {
4176             if {($findloc eq "All fields" || $findloc eq $ty) &&
4177                 [doesmatch $f]} {
4178                 findselectline $l
4179                 notbusy finding
4180                 return 0
4181             }
4182         }
4183     }
4184     if {$l == $findstartline + 1} {
4185         bell
4186         unset findcurline
4187         notbusy finding
4188         return 0
4189     }
4190     set findcurline [expr {$l - 1}]
4191     return 1
4192 }
4193
4194 proc findmorerev {} {
4195     global commitdata commitinfo numcommits findstring findpattern findloc
4196     global findstartline findcurline displayorder
4197
4198     set fldtypes {Headline Author Date Committer CDate Comments}
4199     set l $findcurline
4200     if {$l == 0} {
4201         set l $numcommits
4202     }
4203     incr l -1
4204     if {$l >= $findstartline} {
4205         set lim [expr {$findstartline - 1}]
4206     } else {
4207         set lim -1
4208     }
4209     if {$l - $lim > 500} {
4210         set lim [expr {$l - 500}]
4211     }
4212     set last 0
4213     for {} {$l > $lim} {incr l -1} {
4214         set id [lindex $displayorder $l]
4215         if {![info exists commitdata($id)]} continue
4216         if {![doesmatch $commitdata($id)]} continue
4217         if {![info exists commitinfo($id)]} {
4218             getcommit $id
4219         }
4220         set info $commitinfo($id)
4221         foreach f $info ty $fldtypes {
4222             if {($findloc eq "All fields" || $findloc eq $ty) &&
4223                 [doesmatch $f]} {
4224                 findselectline $l
4225                 notbusy finding
4226                 return 0
4227             }
4228         }
4229     }
4230     if {$l == -1} {
4231         bell
4232         unset findcurline
4233         notbusy finding
4234         return 0
4235     }
4236     set findcurline [expr {$l + 1}]
4237     return 1
4238 }
4239
4240 proc findselectline {l} {
4241     global findloc commentend ctext findcurline markingmatches
4242
4243     set markingmatches 1
4244     set findcurline $l
4245     selectline $l 1
4246     if {$findloc == "All fields" || $findloc == "Comments"} {
4247         # highlight the matches in the comments
4248         set f [$ctext get 1.0 $commentend]
4249         set matches [findmatches $f]
4250         foreach match $matches {
4251             set start [lindex $match 0]
4252             set end [expr {[lindex $match 1] + 1}]
4253             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4254         }
4255     }
4256     drawvisible
4257 }
4258
4259 # mark the bits of a headline or author that match a find string
4260 proc markmatches {canv l str tag matches font row} {
4261     global selectedline
4262
4263     set bbox [$canv bbox $tag]
4264     set x0 [lindex $bbox 0]
4265     set y0 [lindex $bbox 1]
4266     set y1 [lindex $bbox 3]
4267     foreach match $matches {
4268         set start [lindex $match 0]
4269         set end [lindex $match 1]
4270         if {$start > $end} continue
4271         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4272         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4273         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4274                    [expr {$x0+$xlen+2}] $y1 \
4275                    -outline {} -tags [list match$l matches] -fill yellow]
4276         $canv lower $t
4277         if {[info exists selectedline] && $row == $selectedline} {
4278             $canv raise $t secsel
4279         }
4280     }
4281 }
4282
4283 proc unmarkmatches {} {
4284     global findids markingmatches findcurline
4285
4286     allcanvs delete matches
4287     catch {unset findids}
4288     set markingmatches 0
4289     catch {unset findcurline}
4290 }
4291
4292 proc selcanvline {w x y} {
4293     global canv canvy0 ctext linespc
4294     global rowtextx
4295     set ymax [lindex [$canv cget -scrollregion] 3]
4296     if {$ymax == {}} return
4297     set yfrac [lindex [$canv yview] 0]
4298     set y [expr {$y + $yfrac * $ymax}]
4299     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4300     if {$l < 0} {
4301         set l 0
4302     }
4303     if {$w eq $canv} {
4304         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4305     }
4306     unmarkmatches
4307     selectline $l 1
4308 }
4309
4310 proc commit_descriptor {p} {
4311     global commitinfo
4312     if {![info exists commitinfo($p)]} {
4313         getcommit $p
4314     }
4315     set l "..."
4316     if {[llength $commitinfo($p)] > 1} {
4317         set l [lindex $commitinfo($p) 0]
4318     }
4319     return "$p ($l)\n"
4320 }
4321
4322 # append some text to the ctext widget, and make any SHA1 ID
4323 # that we know about be a clickable link.
4324 proc appendwithlinks {text tags} {
4325     global ctext commitrow linknum curview
4326
4327     set start [$ctext index "end - 1c"]
4328     $ctext insert end $text $tags
4329     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4330     foreach l $links {
4331         set s [lindex $l 0]
4332         set e [lindex $l 1]
4333         set linkid [string range $text $s $e]
4334         if {![info exists commitrow($curview,$linkid)]} continue
4335         incr e
4336         $ctext tag add link "$start + $s c" "$start + $e c"
4337         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4338         $ctext tag bind link$linknum <1> \
4339             [list selectline $commitrow($curview,$linkid) 1]
4340         incr linknum
4341     }
4342     $ctext tag conf link -foreground blue -underline 1
4343     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4344     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4345 }
4346
4347 proc viewnextline {dir} {
4348     global canv linespc
4349
4350     $canv delete hover
4351     set ymax [lindex [$canv cget -scrollregion] 3]
4352     set wnow [$canv yview]
4353     set wtop [expr {[lindex $wnow 0] * $ymax}]
4354     set newtop [expr {$wtop + $dir * $linespc}]
4355     if {$newtop < 0} {
4356         set newtop 0
4357     } elseif {$newtop > $ymax} {
4358         set newtop $ymax
4359     }
4360     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4361 }
4362
4363 # add a list of tag or branch names at position pos
4364 # returns the number of names inserted
4365 proc appendrefs {pos ids var} {
4366     global ctext commitrow linknum curview $var maxrefs
4367
4368     if {[catch {$ctext index $pos}]} {
4369         return 0
4370     }
4371     $ctext conf -state normal
4372     $ctext delete $pos "$pos lineend"
4373     set tags {}
4374     foreach id $ids {
4375         foreach tag [set $var\($id\)] {
4376             lappend tags [list $tag $id]
4377         }
4378     }
4379     if {[llength $tags] > $maxrefs} {
4380         $ctext insert $pos "many ([llength $tags])"
4381     } else {
4382         set tags [lsort -index 0 -decreasing $tags]
4383         set sep {}
4384         foreach ti $tags {
4385             set id [lindex $ti 1]
4386             set lk link$linknum
4387             incr linknum
4388             $ctext tag delete $lk
4389             $ctext insert $pos $sep
4390             $ctext insert $pos [lindex $ti 0] $lk
4391             if {[info exists commitrow($curview,$id)]} {
4392                 $ctext tag conf $lk -foreground blue
4393                 $ctext tag bind $lk <1> \
4394                     [list selectline $commitrow($curview,$id) 1]
4395                 $ctext tag conf $lk -underline 1
4396                 $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
4397                 $ctext tag bind $lk <Leave> \
4398                     { %W configure -cursor $curtextcursor }
4399             }
4400             set sep ", "
4401         }
4402     }
4403     $ctext conf -state disabled
4404     return [llength $tags]
4405 }
4406
4407 # called when we have finished computing the nearby tags
4408 proc dispneartags {delay} {
4409     global selectedline currentid showneartags tagphase
4410
4411     if {![info exists selectedline] || !$showneartags} return
4412     after cancel dispnexttag
4413     if {$delay} {
4414         after 200 dispnexttag
4415         set tagphase -1
4416     } else {
4417         after idle dispnexttag
4418         set tagphase 0
4419     }
4420 }
4421
4422 proc dispnexttag {} {
4423     global selectedline currentid showneartags tagphase ctext
4424
4425     if {![info exists selectedline] || !$showneartags} return
4426     switch -- $tagphase {
4427         0 {
4428             set dtags [desctags $currentid]
4429             if {$dtags ne {}} {
4430                 appendrefs precedes $dtags idtags
4431             }
4432         }
4433         1 {
4434             set atags [anctags $currentid]
4435             if {$atags ne {}} {
4436                 appendrefs follows $atags idtags
4437             }
4438         }
4439         2 {
4440             set dheads [descheads $currentid]
4441             if {$dheads ne {}} {
4442                 if {[appendrefs branch $dheads idheads] > 1
4443                     && [$ctext get "branch -3c"] eq "h"} {
4444                     # turn "Branch" into "Branches"
4445                     $ctext conf -state normal
4446                     $ctext insert "branch -2c" "es"
4447                     $ctext conf -state disabled
4448                 }
4449             }
4450         }
4451     }
4452     if {[incr tagphase] <= 2} {
4453         after idle dispnexttag
4454     }
4455 }
4456
4457 proc selectline {l isnew} {
4458     global canv canv2 canv3 ctext commitinfo selectedline
4459     global displayorder linehtag linentag linedtag
4460     global canvy0 linespc parentlist children curview
4461     global currentid sha1entry
4462     global commentend idtags linknum
4463     global mergemax numcommits pending_select
4464     global cmitmode showneartags allcommits
4465
4466     catch {unset pending_select}
4467     $canv delete hover
4468     normalline
4469     cancel_next_highlight
4470     unsel_reflist
4471     if {$l < 0 || $l >= $numcommits} return
4472     set y [expr {$canvy0 + $l * $linespc}]
4473     set ymax [lindex [$canv cget -scrollregion] 3]
4474     set ytop [expr {$y - $linespc - 1}]
4475     set ybot [expr {$y + $linespc + 1}]
4476     set wnow [$canv yview]
4477     set wtop [expr {[lindex $wnow 0] * $ymax}]
4478     set wbot [expr {[lindex $wnow 1] * $ymax}]
4479     set wh [expr {$wbot - $wtop}]
4480     set newtop $wtop
4481     if {$ytop < $wtop} {
4482         if {$ybot < $wtop} {
4483             set newtop [expr {$y - $wh / 2.0}]
4484         } else {
4485             set newtop $ytop
4486             if {$newtop > $wtop - $linespc} {
4487                 set newtop [expr {$wtop - $linespc}]
4488             }
4489         }
4490     } elseif {$ybot > $wbot} {
4491         if {$ytop > $wbot} {
4492             set newtop [expr {$y - $wh / 2.0}]
4493         } else {
4494             set newtop [expr {$ybot - $wh}]
4495             if {$newtop < $wtop + $linespc} {
4496                 set newtop [expr {$wtop + $linespc}]
4497             }
4498         }
4499     }
4500     if {$newtop != $wtop} {
4501         if {$newtop < 0} {
4502             set newtop 0
4503         }
4504         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4505         drawvisible
4506     }
4507
4508     if {![info exists linehtag($l)]} return
4509     $canv delete secsel
4510     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4511                -tags secsel -fill [$canv cget -selectbackground]]
4512     $canv lower $t
4513     $canv2 delete secsel
4514     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4515                -tags secsel -fill [$canv2 cget -selectbackground]]
4516     $canv2 lower $t
4517     $canv3 delete secsel
4518     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4519                -tags secsel -fill [$canv3 cget -selectbackground]]
4520     $canv3 lower $t
4521
4522     if {$isnew} {
4523         addtohistory [list selectline $l 0]
4524     }
4525
4526     set selectedline $l
4527
4528     set id [lindex $displayorder $l]
4529     set currentid $id
4530     $sha1entry delete 0 end
4531     $sha1entry insert 0 $id
4532     $sha1entry selection from 0
4533     $sha1entry selection to end
4534     rhighlight_sel $id
4535
4536     $ctext conf -state normal
4537     clear_ctext
4538     set linknum 0
4539     set info $commitinfo($id)
4540     set date [formatdate [lindex $info 2]]
4541     $ctext insert end "Author: [lindex $info 1]  $date\n"
4542     set date [formatdate [lindex $info 4]]
4543     $ctext insert end "Committer: [lindex $info 3]  $date\n"
4544     if {[info exists idtags($id)]} {
4545         $ctext insert end "Tags:"
4546         foreach tag $idtags($id) {
4547             $ctext insert end " $tag"
4548         }
4549         $ctext insert end "\n"
4550     }
4551
4552     set headers {}
4553     set olds [lindex $parentlist $l]
4554     if {[llength $olds] > 1} {
4555         set np 0
4556         foreach p $olds {
4557             if {$np >= $mergemax} {
4558                 set tag mmax
4559             } else {
4560                 set tag m$np
4561             }
4562             $ctext insert end "Parent: " $tag
4563             appendwithlinks [commit_descriptor $p] {}
4564             incr np
4565         }
4566     } else {
4567         foreach p $olds {
4568             append headers "Parent: [commit_descriptor $p]"
4569         }
4570     }
4571
4572     foreach c $children($curview,$id) {
4573         append headers "Child:  [commit_descriptor $c]"
4574     }
4575
4576     # make anything that looks like a SHA1 ID be a clickable link
4577     appendwithlinks $headers {}
4578     if {$showneartags} {
4579         if {![info exists allcommits]} {
4580             getallcommits
4581         }
4582         $ctext insert end "Branch: "
4583         $ctext mark set branch "end -1c"
4584         $ctext mark gravity branch left
4585         $ctext insert end "\nFollows: "
4586         $ctext mark set follows "end -1c"
4587         $ctext mark gravity follows left
4588         $ctext insert end "\nPrecedes: "
4589         $ctext mark set precedes "end -1c"
4590         $ctext mark gravity precedes left
4591         $ctext insert end "\n"
4592         dispneartags 1
4593     }
4594     $ctext insert end "\n"
4595     set comment [lindex $info 5]
4596     if {[string first "\r" $comment] >= 0} {
4597         set comment [string map {"\r" "\n    "} $comment]
4598     }
4599     appendwithlinks $comment {comment}
4600
4601     $ctext tag remove found 1.0 end
4602     $ctext conf -state disabled
4603     set commentend [$ctext index "end - 1c"]
4604
4605     init_flist "Comments"
4606     if {$cmitmode eq "tree"} {
4607         gettree $id
4608     } elseif {[llength $olds] <= 1} {
4609         startdiff $id
4610     } else {
4611         mergediff $id $l
4612     }
4613 }
4614
4615 proc selfirstline {} {
4616     unmarkmatches
4617     selectline 0 1
4618 }
4619
4620 proc sellastline {} {
4621     global numcommits
4622     unmarkmatches
4623     set l [expr {$numcommits - 1}]
4624     selectline $l 1
4625 }
4626
4627 proc selnextline {dir} {
4628     global selectedline
4629     focus .
4630     if {![info exists selectedline]} return
4631     set l [expr {$selectedline + $dir}]
4632     unmarkmatches
4633     selectline $l 1
4634 }
4635
4636 proc selnextpage {dir} {
4637     global canv linespc selectedline numcommits
4638
4639     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4640     if {$lpp < 1} {
4641         set lpp 1
4642     }
4643     allcanvs yview scroll [expr {$dir * $lpp}] units
4644     drawvisible
4645     if {![info exists selectedline]} return
4646     set l [expr {$selectedline + $dir * $lpp}]
4647     if {$l < 0} {
4648         set l 0
4649     } elseif {$l >= $numcommits} {
4650         set l [expr $numcommits - 1]
4651     }
4652     unmarkmatches
4653     selectline $l 1
4654 }
4655
4656 proc unselectline {} {
4657     global selectedline currentid
4658
4659     catch {unset selectedline}
4660     catch {unset currentid}
4661     allcanvs delete secsel
4662     rhighlight_none
4663     cancel_next_highlight
4664 }
4665
4666 proc reselectline {} {
4667     global selectedline
4668
4669     if {[info exists selectedline]} {
4670         selectline $selectedline 0
4671     }
4672 }
4673
4674 proc addtohistory {cmd} {
4675     global history historyindex curview
4676
4677     set elt [list $curview $cmd]
4678     if {$historyindex > 0
4679         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4680         return
4681     }
4682
4683     if {$historyindex < [llength $history]} {
4684         set history [lreplace $history $historyindex end $elt]
4685     } else {
4686         lappend history $elt
4687     }
4688     incr historyindex
4689     if {$historyindex > 1} {
4690         .tf.bar.leftbut conf -state normal
4691     } else {
4692         .tf.bar.leftbut conf -state disabled
4693     }
4694     .tf.bar.rightbut conf -state disabled
4695 }
4696
4697 proc godo {elt} {
4698     global curview
4699
4700     set view [lindex $elt 0]
4701     set cmd [lindex $elt 1]
4702     if {$curview != $view} {
4703         showview $view
4704     }
4705     eval $cmd
4706 }
4707
4708 proc goback {} {
4709     global history historyindex
4710     focus .
4711
4712     if {$historyindex > 1} {
4713         incr historyindex -1
4714         godo [lindex $history [expr {$historyindex - 1}]]
4715         .tf.bar.rightbut conf -state normal
4716     }
4717     if {$historyindex <= 1} {
4718         .tf.bar.leftbut conf -state disabled
4719     }
4720 }
4721
4722 proc goforw {} {
4723     global history historyindex
4724     focus .
4725
4726     if {$historyindex < [llength $history]} {
4727         set cmd [lindex $history $historyindex]
4728         incr historyindex
4729         godo $cmd
4730         .tf.bar.leftbut conf -state normal
4731     }
4732     if {$historyindex >= [llength $history]} {
4733         .tf.bar.rightbut conf -state disabled
4734     }
4735 }
4736
4737 proc gettree {id} {
4738     global treefilelist treeidlist diffids diffmergeid treepending
4739     global nullid nullid2
4740
4741     set diffids $id
4742     catch {unset diffmergeid}
4743     if {![info exists treefilelist($id)]} {
4744         if {![info exists treepending]} {
4745             if {$id eq $nullid} {
4746                 set cmd [list | git ls-files]
4747             } elseif {$id eq $nullid2} {
4748                 set cmd [list | git ls-files --stage -t]
4749             } else {
4750                 set cmd [list | git ls-tree -r $id]
4751             }
4752             if {[catch {set gtf [open $cmd r]}]} {
4753                 return
4754             }
4755             set treepending $id
4756             set treefilelist($id) {}
4757             set treeidlist($id) {}
4758             fconfigure $gtf -blocking 0
4759             filerun $gtf [list gettreeline $gtf $id]
4760         }
4761     } else {
4762         setfilelist $id
4763     }
4764 }
4765
4766 proc gettreeline {gtf id} {
4767     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4768
4769     set nl 0
4770     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4771         if {$diffids eq $nullid} {
4772             set fname $line
4773         } else {
4774             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4775             set i [string first "\t" $line]
4776             if {$i < 0} continue
4777             set sha1 [lindex $line 2]
4778             set fname [string range $line [expr {$i+1}] end]
4779             if {[string index $fname 0] eq "\""} {
4780                 set fname [lindex $fname 0]
4781             }
4782             lappend treeidlist($id) $sha1
4783         }
4784         lappend treefilelist($id) $fname
4785     }
4786     if {![eof $gtf]} {
4787         return [expr {$nl >= 1000? 2: 1}]
4788     }
4789     close $gtf
4790     unset treepending
4791     if {$cmitmode ne "tree"} {
4792         if {![info exists diffmergeid]} {
4793             gettreediffs $diffids
4794         }
4795     } elseif {$id ne $diffids} {
4796         gettree $diffids
4797     } else {
4798         setfilelist $id
4799     }
4800     return 0
4801 }
4802
4803 proc showfile {f} {
4804     global treefilelist treeidlist diffids nullid nullid2
4805     global ctext commentend
4806
4807     set i [lsearch -exact $treefilelist($diffids) $f]
4808     if {$i < 0} {
4809         puts "oops, $f not in list for id $diffids"
4810         return
4811     }
4812     if {$diffids eq $nullid} {
4813         if {[catch {set bf [open $f r]} err]} {
4814             puts "oops, can't read $f: $err"
4815             return
4816         }
4817     } else {
4818         set blob [lindex $treeidlist($diffids) $i]
4819         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4820             puts "oops, error reading blob $blob: $err"
4821             return
4822         }
4823     }
4824     fconfigure $bf -blocking 0
4825     filerun $bf [list getblobline $bf $diffids]
4826     $ctext config -state normal
4827     clear_ctext $commentend
4828     $ctext insert end "\n"
4829     $ctext insert end "$f\n" filesep
4830     $ctext config -state disabled
4831     $ctext yview $commentend
4832 }
4833
4834 proc getblobline {bf id} {
4835     global diffids cmitmode ctext
4836
4837     if {$id ne $diffids || $cmitmode ne "tree"} {
4838         catch {close $bf}
4839         return 0
4840     }
4841     $ctext config -state normal
4842     set nl 0
4843     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
4844         $ctext insert end "$line\n"
4845     }
4846     if {[eof $bf]} {
4847         # delete last newline
4848         $ctext delete "end - 2c" "end - 1c"
4849         close $bf
4850         return 0
4851     }
4852     $ctext config -state disabled
4853     return [expr {$nl >= 1000? 2: 1}]
4854 }
4855
4856 proc mergediff {id l} {
4857     global diffmergeid diffopts mdifffd
4858     global diffids
4859     global parentlist
4860
4861     set diffmergeid $id
4862     set diffids $id
4863     # this doesn't seem to actually affect anything...
4864     set env(GIT_DIFF_OPTS) $diffopts
4865     set cmd [concat | git diff-tree --no-commit-id --cc $id]
4866     if {[catch {set mdf [open $cmd r]} err]} {
4867         error_popup "Error getting merge diffs: $err"
4868         return
4869     }
4870     fconfigure $mdf -blocking 0
4871     set mdifffd($id) $mdf
4872     set np [llength [lindex $parentlist $l]]
4873     filerun $mdf [list getmergediffline $mdf $id $np]
4874 }
4875
4876 proc getmergediffline {mdf id np} {
4877     global diffmergeid ctext cflist mergemax
4878     global difffilestart mdifffd
4879
4880     $ctext conf -state normal
4881     set nr 0
4882     while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
4883         if {![info exists diffmergeid] || $id != $diffmergeid
4884             || $mdf != $mdifffd($id)} {
4885             close $mdf
4886             return 0
4887         }
4888         if {[regexp {^diff --cc (.*)} $line match fname]} {
4889             # start of a new file
4890             $ctext insert end "\n"
4891             set here [$ctext index "end - 1c"]
4892             lappend difffilestart $here
4893             add_flist [list $fname]
4894             set l [expr {(78 - [string length $fname]) / 2}]
4895             set pad [string range "----------------------------------------" 1 $l]
4896             $ctext insert end "$pad $fname $pad\n" filesep
4897         } elseif {[regexp {^@@} $line]} {
4898             $ctext insert end "$line\n" hunksep
4899         } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4900             # do nothing
4901         } else {
4902             # parse the prefix - one ' ', '-' or '+' for each parent
4903             set spaces {}
4904             set minuses {}
4905             set pluses {}
4906             set isbad 0
4907             for {set j 0} {$j < $np} {incr j} {
4908                 set c [string range $line $j $j]
4909                 if {$c == " "} {
4910                     lappend spaces $j
4911                 } elseif {$c == "-"} {
4912                     lappend minuses $j
4913                 } elseif {$c == "+"} {
4914                     lappend pluses $j
4915                 } else {
4916                     set isbad 1
4917                     break
4918                 }
4919             }
4920             set tags {}
4921             set num {}
4922             if {!$isbad && $minuses ne {} && $pluses eq {}} {
4923                 # line doesn't appear in result, parents in $minuses have the line
4924                 set num [lindex $minuses 0]
4925             } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4926                 # line appears in result, parents in $pluses don't have the line
4927                 lappend tags mresult
4928                 set num [lindex $spaces 0]
4929             }
4930             if {$num ne {}} {
4931                 if {$num >= $mergemax} {
4932                     set num "max"
4933                 }
4934                 lappend tags m$num
4935             }
4936             $ctext insert end "$line\n" $tags
4937         }
4938     }
4939     $ctext conf -state disabled
4940     if {[eof $mdf]} {
4941         close $mdf
4942         return 0
4943     }
4944     return [expr {$nr >= 1000? 2: 1}]
4945 }
4946
4947 proc startdiff {ids} {
4948     global treediffs diffids treepending diffmergeid nullid nullid2
4949
4950     set diffids $ids
4951     catch {unset diffmergeid}
4952     if {![info exists treediffs($ids)] ||
4953         [lsearch -exact $ids $nullid] >= 0 ||
4954         [lsearch -exact $ids $nullid2] >= 0} {
4955         if {![info exists treepending]} {
4956             gettreediffs $ids
4957         }
4958     } else {
4959         addtocflist $ids
4960     }
4961 }
4962
4963 proc addtocflist {ids} {
4964     global treediffs cflist
4965     add_flist $treediffs($ids)
4966     getblobdiffs $ids
4967 }
4968
4969 proc diffcmd {ids flags} {
4970     global nullid nullid2
4971
4972     set i [lsearch -exact $ids $nullid]
4973     set j [lsearch -exact $ids $nullid2]
4974     if {$i >= 0} {
4975         if {[llength $ids] > 1 && $j < 0} {
4976             # comparing working directory with some specific revision
4977             set cmd [concat | git diff-index $flags]
4978             if {$i == 0} {
4979                 lappend cmd -R [lindex $ids 1]
4980             } else {
4981                 lappend cmd [lindex $ids 0]
4982             }
4983         } else {
4984             # comparing working directory with index
4985             set cmd [concat | git diff-files $flags]
4986             if {$j == 1} {
4987                 lappend cmd -R
4988             }
4989         }
4990     } elseif {$j >= 0} {
4991         set cmd [concat | git diff-index --cached $flags]
4992         if {[llength $ids] > 1} {
4993             # comparing index with specific revision
4994             if {$i == 0} {
4995                 lappend cmd -R [lindex $ids 1]
4996             } else {
4997                 lappend cmd [lindex $ids 0]
4998             }
4999         } else {
5000             # comparing index with HEAD
5001             lappend cmd HEAD
5002         }
5003     } else {
5004         set cmd [concat | git diff-tree -r $flags $ids]
5005     }
5006     return $cmd
5007 }
5008
5009 proc gettreediffs {ids} {
5010     global treediff treepending
5011
5012     set treepending $ids
5013     set treediff {}
5014     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5015     fconfigure $gdtf -blocking 0
5016     filerun $gdtf [list gettreediffline $gdtf $ids]
5017 }
5018
5019 proc gettreediffline {gdtf ids} {
5020     global treediff treediffs treepending diffids diffmergeid
5021     global cmitmode
5022
5023     set nr 0
5024     while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5025         set i [string first "\t" $line]
5026         if {$i >= 0} {
5027             set file [string range $line [expr {$i+1}] end]
5028             if {[string index $file 0] eq "\""} {
5029                 set file [lindex $file 0]
5030             }
5031             lappend treediff $file
5032         }
5033     }
5034     if {![eof $gdtf]} {
5035         return [expr {$nr >= 1000? 2: 1}]
5036     }
5037     close $gdtf
5038     set treediffs($ids) $treediff
5039     unset treepending
5040     if {$cmitmode eq "tree"} {
5041         gettree $diffids
5042     } elseif {$ids != $diffids} {
5043         if {![info exists diffmergeid]} {
5044             gettreediffs $diffids
5045         }
5046     } else {
5047         addtocflist $ids
5048     }
5049     return 0
5050 }
5051
5052 # empty string or positive integer
5053 proc diffcontextvalidate {v} {
5054     return [regexp {^(|[1-9][0-9]*)$} $v]
5055 }
5056
5057 proc diffcontextchange {n1 n2 op} {
5058     global diffcontextstring diffcontext
5059
5060     if {[string is integer -strict $diffcontextstring]} {
5061         if {$diffcontextstring > 0} {
5062             set diffcontext $diffcontextstring
5063             reselectline
5064         }
5065     }
5066 }
5067
5068 proc getblobdiffs {ids} {
5069     global diffopts blobdifffd diffids env
5070     global diffinhdr treediffs
5071     global diffcontext
5072
5073     set env(GIT_DIFF_OPTS) $diffopts
5074     if {[catch {set bdf [open [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] r]} err]} {
5075         puts "error getting diffs: $err"
5076         return
5077     }
5078     set diffinhdr 0
5079     fconfigure $bdf -blocking 0
5080     set blobdifffd($ids) $bdf
5081     filerun $bdf [list getblobdiffline $bdf $diffids]
5082 }
5083
5084 proc setinlist {var i val} {
5085     global $var
5086
5087     while {[llength [set $var]] < $i} {
5088         lappend $var {}
5089     }
5090     if {[llength [set $var]] == $i} {
5091         lappend $var $val
5092     } else {
5093         lset $var $i $val
5094     }
5095 }
5096
5097 proc makediffhdr {fname ids} {
5098     global ctext curdiffstart treediffs
5099
5100     set i [lsearch -exact $treediffs($ids) $fname]
5101     if {$i >= 0} {
5102         setinlist difffilestart $i $curdiffstart
5103     }
5104     set l [expr {(78 - [string length $fname]) / 2}]
5105     set pad [string range "----------------------------------------" 1 $l]
5106     $ctext insert $curdiffstart "$pad $fname $pad" filesep
5107 }
5108
5109 proc getblobdiffline {bdf ids} {
5110     global diffids blobdifffd ctext curdiffstart
5111     global diffnexthead diffnextnote difffilestart
5112     global diffinhdr treediffs
5113
5114     set nr 0
5115     $ctext conf -state normal
5116     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5117         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5118             close $bdf
5119             return 0
5120         }
5121         if {![string compare -length 11 "diff --git " $line]} {
5122             # trim off "diff --git "
5123             set line [string range $line 11 end]
5124             set diffinhdr 1
5125             # start of a new file
5126             $ctext insert end "\n"
5127             set curdiffstart [$ctext index "end - 1c"]
5128             $ctext insert end "\n" filesep
5129             # If the name hasn't changed the length will be odd,
5130             # the middle char will be a space, and the two bits either
5131             # side will be a/name and b/name, or "a/name" and "b/name".
5132             # If the name has changed we'll get "rename from" and
5133             # "rename to" or "copy from" and "copy to" lines following this,
5134             # and we'll use them to get the filenames.
5135             # This complexity is necessary because spaces in the filename(s)
5136             # don't get escaped.
5137             set l [string length $line]
5138             set i [expr {$l / 2}]
5139             if {!(($l & 1) && [string index $line $i] eq " " &&
5140                   [string range $line 2 [expr {$i - 1}]] eq \
5141                       [string range $line [expr {$i + 3}] end])} {
5142                 continue
5143             }
5144             # unescape if quoted and chop off the a/ from the front
5145             if {[string index $line 0] eq "\""} {
5146                 set fname [string range [lindex $line 0] 2 end]
5147             } else {
5148                 set fname [string range $line 2 [expr {$i - 1}]]
5149             }
5150             makediffhdr $fname $ids
5151
5152         } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5153                        $line match f1l f1c f2l f2c rest]} {
5154             $ctext insert end "$line\n" hunksep
5155             set diffinhdr 0
5156
5157         } elseif {$diffinhdr} {
5158             if {![string compare -length 12 "rename from " $line] ||
5159                 ![string compare -length 10 "copy from " $line]} {
5160                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5161                 if {[string index $fname 0] eq "\""} {
5162                     set fname [lindex $fname 0]
5163                 }
5164                 set i [lsearch -exact $treediffs($ids) $fname]
5165                 if {$i >= 0} {
5166                     setinlist difffilestart $i $curdiffstart
5167                 }
5168             } elseif {![string compare -length 10 $line "rename to "] ||
5169                       ![string compare -length 8 $line "copy to "]} {
5170                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5171                 if {[string index $fname 0] eq "\""} {
5172                     set fname [lindex $fname 0]
5173                 }
5174                 makediffhdr $fname $ids
5175             } elseif {[string compare -length 3 $line "---"] == 0} {
5176                 # do nothing
5177                 continue
5178             } elseif {[string compare -length 3 $line "+++"] == 0} {
5179                 set diffinhdr 0
5180                 continue
5181             }
5182             $ctext insert end "$line\n" filesep
5183
5184         } else {
5185             set x [string range $line 0 0]
5186             if {$x == "-" || $x == "+"} {
5187                 set tag [expr {$x == "+"}]
5188                 $ctext insert end "$line\n" d$tag
5189             } elseif {$x == " "} {
5190                 $ctext insert end "$line\n"
5191             } else {
5192                 # "\ No newline at end of file",
5193                 # or something else we don't recognize
5194                 $ctext insert end "$line\n" hunksep
5195             }
5196         }
5197     }
5198     $ctext conf -state disabled
5199     if {[eof $bdf]} {
5200         close $bdf
5201         return 0
5202     }
5203     return [expr {$nr >= 1000? 2: 1}]
5204 }
5205
5206 proc changediffdisp {} {
5207     global ctext diffelide
5208
5209     $ctext tag conf d0 -elide [lindex $diffelide 0]
5210     $ctext tag conf d1 -elide [lindex $diffelide 1]
5211 }
5212
5213 proc prevfile {} {
5214     global difffilestart ctext
5215     set prev [lindex $difffilestart 0]
5216     set here [$ctext index @0,0]
5217     foreach loc $difffilestart {
5218         if {[$ctext compare $loc >= $here]} {
5219             $ctext yview $prev
5220             return
5221         }
5222         set prev $loc
5223     }
5224     $ctext yview $prev
5225 }
5226
5227 proc nextfile {} {
5228     global difffilestart ctext
5229     set here [$ctext index @0,0]
5230     foreach loc $difffilestart {
5231         if {[$ctext compare $loc > $here]} {
5232             $ctext yview $loc
5233             return
5234         }
5235     }
5236 }
5237
5238 proc clear_ctext {{first 1.0}} {
5239     global ctext smarktop smarkbot
5240
5241     set l [lindex [split $first .] 0]
5242     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5243         set smarktop $l
5244     }
5245     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5246         set smarkbot $l
5247     }
5248     $ctext delete $first end
5249 }
5250
5251 proc incrsearch {name ix op} {
5252     global ctext searchstring searchdirn
5253
5254     $ctext tag remove found 1.0 end
5255     if {[catch {$ctext index anchor}]} {
5256         # no anchor set, use start of selection, or of visible area
5257         set sel [$ctext tag ranges sel]
5258         if {$sel ne {}} {
5259             $ctext mark set anchor [lindex $sel 0]
5260         } elseif {$searchdirn eq "-forwards"} {
5261             $ctext mark set anchor @0,0
5262         } else {
5263             $ctext mark set anchor @0,[winfo height $ctext]
5264         }
5265     }
5266     if {$searchstring ne {}} {
5267         set here [$ctext search $searchdirn -- $searchstring anchor]
5268         if {$here ne {}} {
5269             $ctext see $here
5270         }
5271         searchmarkvisible 1
5272     }
5273 }
5274
5275 proc dosearch {} {
5276     global sstring ctext searchstring searchdirn
5277
5278     focus $sstring
5279     $sstring icursor end
5280     set searchdirn -forwards
5281     if {$searchstring ne {}} {
5282         set sel [$ctext tag ranges sel]
5283         if {$sel ne {}} {
5284             set start "[lindex $sel 0] + 1c"
5285         } elseif {[catch {set start [$ctext index anchor]}]} {
5286             set start "@0,0"
5287         }
5288         set match [$ctext search -count mlen -- $searchstring $start]
5289         $ctext tag remove sel 1.0 end
5290         if {$match eq {}} {
5291             bell
5292             return
5293         }
5294         $ctext see $match
5295         set mend "$match + $mlen c"
5296         $ctext tag add sel $match $mend
5297         $ctext mark unset anchor
5298     }
5299 }
5300
5301 proc dosearchback {} {
5302     global sstring ctext searchstring searchdirn
5303
5304     focus $sstring
5305     $sstring icursor end
5306     set searchdirn -backwards
5307     if {$searchstring ne {}} {
5308         set sel [$ctext tag ranges sel]
5309         if {$sel ne {}} {
5310             set start [lindex $sel 0]
5311         } elseif {[catch {set start [$ctext index anchor]}]} {
5312             set start @0,[winfo height $ctext]
5313         }
5314         set match [$ctext search -backwards -count ml -- $searchstring $start]
5315         $ctext tag remove sel 1.0 end
5316         if {$match eq {}} {
5317             bell
5318             return
5319         }
5320         $ctext see $match
5321         set mend "$match + $ml c"
5322         $ctext tag add sel $match $mend
5323         $ctext mark unset anchor
5324     }
5325 }
5326
5327 proc searchmark {first last} {
5328     global ctext searchstring
5329
5330     set mend $first.0
5331     while {1} {
5332         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5333         if {$match eq {}} break
5334         set mend "$match + $mlen c"
5335         $ctext tag add found $match $mend
5336     }
5337 }
5338
5339 proc searchmarkvisible {doall} {
5340     global ctext smarktop smarkbot
5341
5342     set topline [lindex [split [$ctext index @0,0] .] 0]
5343     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5344     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5345         # no overlap with previous
5346         searchmark $topline $botline
5347         set smarktop $topline
5348         set smarkbot $botline
5349     } else {
5350         if {$topline < $smarktop} {
5351             searchmark $topline [expr {$smarktop-1}]
5352             set smarktop $topline
5353         }
5354         if {$botline > $smarkbot} {
5355             searchmark [expr {$smarkbot+1}] $botline
5356             set smarkbot $botline
5357         }
5358     }
5359 }
5360
5361 proc scrolltext {f0 f1} {
5362     global searchstring
5363
5364     .bleft.sb set $f0 $f1
5365     if {$searchstring ne {}} {
5366         searchmarkvisible 0
5367     }
5368 }
5369
5370 proc setcoords {} {
5371     global linespc charspc canvx0 canvy0 mainfont
5372     global xspc1 xspc2 lthickness
5373
5374     set linespc [font metrics $mainfont -linespace]
5375     set charspc [font measure $mainfont "m"]
5376     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5377     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5378     set lthickness [expr {int($linespc / 9) + 1}]
5379     set xspc1(0) $linespc
5380     set xspc2 $linespc
5381 }
5382
5383 proc redisplay {} {
5384     global canv
5385     global selectedline
5386
5387     set ymax [lindex [$canv cget -scrollregion] 3]
5388     if {$ymax eq {} || $ymax == 0} return
5389     set span [$canv yview]
5390     clear_display
5391     setcanvscroll
5392     allcanvs yview moveto [lindex $span 0]
5393     drawvisible
5394     if {[info exists selectedline]} {
5395         selectline $selectedline 0
5396         allcanvs yview moveto [lindex $span 0]
5397     }
5398 }
5399
5400 proc incrfont {inc} {
5401     global mainfont textfont ctext canv phase cflist showrefstop
5402     global charspc tabstop
5403     global stopped entries
5404     unmarkmatches
5405     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
5406     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
5407     setcoords
5408     $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
5409     $cflist conf -font $textfont
5410     $ctext tag conf filesep -font [concat $textfont bold]
5411     foreach e $entries {
5412         $e conf -font $mainfont
5413     }
5414     if {$phase eq "getcommits"} {
5415         $canv itemconf textitems -font $mainfont
5416     }
5417     if {[info exists showrefstop] && [winfo exists $showrefstop]} {
5418         $showrefstop.list conf -font $mainfont
5419     }
5420     redisplay
5421 }
5422
5423 proc clearsha1 {} {
5424     global sha1entry sha1string
5425     if {[string length $sha1string] == 40} {
5426         $sha1entry delete 0 end
5427     }
5428 }
5429
5430 proc sha1change {n1 n2 op} {
5431     global sha1string currentid sha1but
5432     if {$sha1string == {}
5433         || ([info exists currentid] && $sha1string == $currentid)} {
5434         set state disabled
5435     } else {
5436         set state normal
5437     }
5438     if {[$sha1but cget -state] == $state} return
5439     if {$state == "normal"} {
5440         $sha1but conf -state normal -relief raised -text "Goto: "
5441     } else {
5442         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
5443     }
5444 }
5445
5446 proc gotocommit {} {
5447     global sha1string currentid commitrow tagids headids
5448     global displayorder numcommits curview
5449
5450     if {$sha1string == {}
5451         || ([info exists currentid] && $sha1string == $currentid)} return
5452     if {[info exists tagids($sha1string)]} {
5453         set id $tagids($sha1string)
5454     } elseif {[info exists headids($sha1string)]} {
5455         set id $headids($sha1string)
5456     } else {
5457         set id [string tolower $sha1string]
5458         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5459             set matches {}
5460             foreach i $displayorder {
5461                 if {[string match $id* $i]} {
5462                     lappend matches $i
5463                 }
5464             }
5465             if {$matches ne {}} {
5466                 if {[llength $matches] > 1} {
5467                     error_popup "Short SHA1 id $id is ambiguous"
5468                     return
5469                 }
5470                 set id [lindex $matches 0]
5471             }
5472         }
5473     }
5474     if {[info exists commitrow($curview,$id)]} {
5475         selectline $commitrow($curview,$id) 1
5476         return
5477     }
5478     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5479         set type "SHA1 id"
5480     } else {
5481         set type "Tag/Head"
5482     }
5483     error_popup "$type $sha1string is not known"
5484 }
5485
5486 proc lineenter {x y id} {
5487     global hoverx hovery hoverid hovertimer
5488     global commitinfo canv
5489
5490     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5491     set hoverx $x
5492     set hovery $y
5493     set hoverid $id
5494     if {[info exists hovertimer]} {
5495         after cancel $hovertimer
5496     }
5497     set hovertimer [after 500 linehover]
5498     $canv delete hover
5499 }
5500
5501 proc linemotion {x y id} {
5502     global hoverx hovery hoverid hovertimer
5503
5504     if {[info exists hoverid] && $id == $hoverid} {
5505         set hoverx $x
5506         set hovery $y
5507         if {[info exists hovertimer]} {
5508             after cancel $hovertimer
5509         }
5510         set hovertimer [after 500 linehover]
5511     }
5512 }
5513
5514 proc lineleave {id} {
5515     global hoverid hovertimer canv
5516
5517     if {[info exists hoverid] && $id == $hoverid} {
5518         $canv delete hover
5519         if {[info exists hovertimer]} {
5520             after cancel $hovertimer
5521             unset hovertimer
5522         }
5523         unset hoverid
5524     }
5525 }
5526
5527 proc linehover {} {
5528     global hoverx hovery hoverid hovertimer
5529     global canv linespc lthickness
5530     global commitinfo mainfont
5531
5532     set text [lindex $commitinfo($hoverid) 0]
5533     set ymax [lindex [$canv cget -scrollregion] 3]
5534     if {$ymax == {}} return
5535     set yfrac [lindex [$canv yview] 0]
5536     set x [expr {$hoverx + 2 * $linespc}]
5537     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5538     set x0 [expr {$x - 2 * $lthickness}]
5539     set y0 [expr {$y - 2 * $lthickness}]
5540     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
5541     set y1 [expr {$y + $linespc + 2 * $lthickness}]
5542     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5543                -fill \#ffff80 -outline black -width 1 -tags hover]
5544     $canv raise $t
5545     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5546                -font $mainfont]
5547     $canv raise $t
5548 }
5549
5550 proc clickisonarrow {id y} {
5551     global lthickness
5552
5553     set ranges [rowranges $id]
5554     set thresh [expr {2 * $lthickness + 6}]
5555     set n [expr {[llength $ranges] - 1}]
5556     for {set i 1} {$i < $n} {incr i} {
5557         set row [lindex $ranges $i]
5558         if {abs([yc $row] - $y) < $thresh} {
5559             return $i
5560         }
5561     }
5562     return {}
5563 }
5564
5565 proc arrowjump {id n y} {
5566     global canv
5567
5568     # 1 <-> 2, 3 <-> 4, etc...
5569     set n [expr {(($n - 1) ^ 1) + 1}]
5570     set row [lindex [rowranges $id] $n]
5571     set yt [yc $row]
5572     set ymax [lindex [$canv cget -scrollregion] 3]
5573     if {$ymax eq {} || $ymax <= 0} return
5574     set view [$canv yview]
5575     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5576     set yfrac [expr {$yt / $ymax - $yspan / 2}]
5577     if {$yfrac < 0} {
5578         set yfrac 0
5579     }
5580     allcanvs yview moveto $yfrac
5581 }
5582
5583 proc lineclick {x y id isnew} {
5584     global ctext commitinfo children canv thickerline curview
5585
5586     if {![info exists commitinfo($id)] && ![getcommit $id]} return
5587     unmarkmatches
5588     unselectline
5589     normalline
5590     $canv delete hover
5591     # draw this line thicker than normal
5592     set thickerline $id
5593     drawlines $id
5594     if {$isnew} {
5595         set ymax [lindex [$canv cget -scrollregion] 3]
5596         if {$ymax eq {}} return
5597         set yfrac [lindex [$canv yview] 0]
5598         set y [expr {$y + $yfrac * $ymax}]
5599     }
5600     set dirn [clickisonarrow $id $y]
5601     if {$dirn ne {}} {
5602         arrowjump $id $dirn $y
5603         return
5604     }
5605
5606     if {$isnew} {
5607         addtohistory [list lineclick $x $y $id 0]
5608     }
5609     # fill the details pane with info about this line
5610     $ctext conf -state normal
5611     clear_ctext
5612     $ctext tag conf link -foreground blue -underline 1
5613     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5614     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5615     $ctext insert end "Parent:\t"
5616     $ctext insert end $id [list link link0]
5617     $ctext tag bind link0 <1> [list selbyid $id]
5618     set info $commitinfo($id)
5619     $ctext insert end "\n\t[lindex $info 0]\n"
5620     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
5621     set date [formatdate [lindex $info 2]]
5622     $ctext insert end "\tDate:\t$date\n"
5623     set kids $children($curview,$id)
5624     if {$kids ne {}} {
5625         $ctext insert end "\nChildren:"
5626         set i 0
5627         foreach child $kids {
5628             incr i
5629             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5630             set info $commitinfo($child)
5631             $ctext insert end "\n\t"
5632             $ctext insert end $child [list link link$i]
5633             $ctext tag bind link$i <1> [list selbyid $child]
5634             $ctext insert end "\n\t[lindex $info 0]"
5635             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
5636             set date [formatdate [lindex $info 2]]
5637             $ctext insert end "\n\tDate:\t$date\n"
5638         }
5639     }
5640     $ctext conf -state disabled
5641     init_flist {}
5642 }
5643
5644 proc normalline {} {
5645     global thickerline
5646     if {[info exists thickerline]} {
5647         set id $thickerline
5648         unset thickerline
5649         drawlines $id
5650     }
5651 }
5652
5653 proc selbyid {id} {
5654     global commitrow curview
5655     if {[info exists commitrow($curview,$id)]} {
5656         selectline $commitrow($curview,$id) 1
5657     }
5658 }
5659
5660 proc mstime {} {
5661     global startmstime
5662     if {![info exists startmstime]} {
5663         set startmstime [clock clicks -milliseconds]
5664     }
5665     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
5666 }
5667
5668 proc rowmenu {x y id} {
5669     global rowctxmenu commitrow selectedline rowmenuid curview
5670     global nullid nullid2 fakerowmenu mainhead
5671
5672     set rowmenuid $id
5673     if {![info exists selectedline]
5674         || $commitrow($curview,$id) eq $selectedline} {
5675         set state disabled
5676     } else {
5677         set state normal
5678     }
5679     if {$id ne $nullid && $id ne $nullid2} {
5680         set menu $rowctxmenu
5681         $menu entryconfigure 7 -label "Reset $mainhead branch to here"
5682     } else {
5683         set menu $fakerowmenu
5684     }
5685     $menu entryconfigure "Diff this*" -state $state
5686     $menu entryconfigure "Diff selected*" -state $state
5687     $menu entryconfigure "Make patch" -state $state
5688     tk_popup $menu $x $y
5689 }
5690
5691 proc diffvssel {dirn} {
5692     global rowmenuid selectedline displayorder
5693
5694     if {![info exists selectedline]} return
5695     if {$dirn} {
5696         set oldid [lindex $displayorder $selectedline]
5697         set newid $rowmenuid
5698     } else {
5699         set oldid $rowmenuid
5700         set newid [lindex $displayorder $selectedline]
5701     }
5702     addtohistory [list doseldiff $oldid $newid]
5703     doseldiff $oldid $newid
5704 }
5705
5706 proc doseldiff {oldid newid} {
5707     global ctext
5708     global commitinfo
5709
5710     $ctext conf -state normal
5711     clear_ctext
5712     init_flist "Top"
5713     $ctext insert end "From "
5714     $ctext tag conf link -foreground blue -underline 1
5715     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
5716     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
5717     $ctext tag bind link0 <1> [list selbyid $oldid]
5718     $ctext insert end $oldid [list link link0]
5719     $ctext insert end "\n     "
5720     $ctext insert end [lindex $commitinfo($oldid) 0]
5721     $ctext insert end "\n\nTo   "
5722     $ctext tag bind link1 <1> [list selbyid $newid]
5723     $ctext insert end $newid [list link link1]
5724     $ctext insert end "\n     "
5725     $ctext insert end [lindex $commitinfo($newid) 0]
5726     $ctext insert end "\n"
5727     $ctext conf -state disabled
5728     $ctext tag remove found 1.0 end
5729     startdiff [list $oldid $newid]
5730 }
5731
5732 proc mkpatch {} {
5733     global rowmenuid currentid commitinfo patchtop patchnum
5734
5735     if {![info exists currentid]} return
5736     set oldid $currentid
5737     set oldhead [lindex $commitinfo($oldid) 0]
5738     set newid $rowmenuid
5739     set newhead [lindex $commitinfo($newid) 0]
5740     set top .patch
5741     set patchtop $top
5742     catch {destroy $top}
5743     toplevel $top
5744     label $top.title -text "Generate patch"
5745     grid $top.title - -pady 10
5746     label $top.from -text "From:"
5747     entry $top.fromsha1 -width 40 -relief flat
5748     $top.fromsha1 insert 0 $oldid
5749     $top.fromsha1 conf -state readonly
5750     grid $top.from $top.fromsha1 -sticky w
5751     entry $top.fromhead -width 60 -relief flat
5752     $top.fromhead insert 0 $oldhead
5753     $top.fromhead conf -state readonly
5754     grid x $top.fromhead -sticky w
5755     label $top.to -text "To:"
5756     entry $top.tosha1 -width 40 -relief flat
5757     $top.tosha1 insert 0 $newid
5758     $top.tosha1 conf -state readonly
5759     grid $top.to $top.tosha1 -sticky w
5760     entry $top.tohead -width 60 -relief flat
5761     $top.tohead insert 0 $newhead
5762     $top.tohead conf -state readonly
5763     grid x $top.tohead -sticky w
5764     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
5765     grid $top.rev x -pady 10
5766     label $top.flab -text "Output file:"
5767     entry $top.fname -width 60
5768     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
5769     incr patchnum
5770     grid $top.flab $top.fname -sticky w
5771     frame $top.buts
5772     button $top.buts.gen -text "Generate" -command mkpatchgo
5773     button $top.buts.can -text "Cancel" -command mkpatchcan
5774     grid $top.buts.gen $top.buts.can
5775     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5776     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5777     grid $top.buts - -pady 10 -sticky ew
5778     focus $top.fname
5779 }
5780
5781 proc mkpatchrev {} {
5782     global patchtop
5783
5784     set oldid [$patchtop.fromsha1 get]
5785     set oldhead [$patchtop.fromhead get]
5786     set newid [$patchtop.tosha1 get]
5787     set newhead [$patchtop.tohead get]
5788     foreach e [list fromsha1 fromhead tosha1 tohead] \
5789             v [list $newid $newhead $oldid $oldhead] {
5790         $patchtop.$e conf -state normal
5791         $patchtop.$e delete 0 end
5792         $patchtop.$e insert 0 $v
5793         $patchtop.$e conf -state readonly
5794     }
5795 }
5796
5797 proc mkpatchgo {} {
5798     global patchtop nullid nullid2
5799
5800     set oldid [$patchtop.fromsha1 get]
5801     set newid [$patchtop.tosha1 get]
5802     set fname [$patchtop.fname get]
5803     set cmd [diffcmd [list $oldid $newid] -p]
5804     lappend cmd >$fname &
5805     if {[catch {eval exec $cmd} err]} {
5806         error_popup "Error creating patch: $err"
5807     }
5808     catch {destroy $patchtop}
5809     unset patchtop
5810 }
5811
5812 proc mkpatchcan {} {
5813     global patchtop
5814
5815     catch {destroy $patchtop}
5816     unset patchtop
5817 }
5818
5819 proc mktag {} {
5820     global rowmenuid mktagtop commitinfo
5821
5822     set top .maketag
5823     set mktagtop $top
5824     catch {destroy $top}
5825     toplevel $top
5826     label $top.title -text "Create tag"
5827     grid $top.title - -pady 10
5828     label $top.id -text "ID:"
5829     entry $top.sha1 -width 40 -relief flat
5830     $top.sha1 insert 0 $rowmenuid
5831     $top.sha1 conf -state readonly
5832     grid $top.id $top.sha1 -sticky w
5833     entry $top.head -width 60 -relief flat
5834     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5835     $top.head conf -state readonly
5836     grid x $top.head -sticky w
5837     label $top.tlab -text "Tag name:"
5838     entry $top.tag -width 60
5839     grid $top.tlab $top.tag -sticky w
5840     frame $top.buts
5841     button $top.buts.gen -text "Create" -command mktaggo
5842     button $top.buts.can -text "Cancel" -command mktagcan
5843     grid $top.buts.gen $top.buts.can
5844     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5845     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5846     grid $top.buts - -pady 10 -sticky ew
5847     focus $top.tag
5848 }
5849
5850 proc domktag {} {
5851     global mktagtop env tagids idtags
5852
5853     set id [$mktagtop.sha1 get]
5854     set tag [$mktagtop.tag get]
5855     if {$tag == {}} {
5856         error_popup "No tag name specified"
5857         return
5858     }
5859     if {[info exists tagids($tag)]} {
5860         error_popup "Tag \"$tag\" already exists"
5861         return
5862     }
5863     if {[catch {
5864         set dir [gitdir]
5865         set fname [file join $dir "refs/tags" $tag]
5866         set f [open $fname w]
5867         puts $f $id
5868         close $f
5869     } err]} {
5870         error_popup "Error creating tag: $err"
5871         return
5872     }
5873
5874     set tagids($tag) $id
5875     lappend idtags($id) $tag
5876     redrawtags $id
5877     addedtag $id
5878     dispneartags 0
5879     run refill_reflist
5880 }
5881
5882 proc redrawtags {id} {
5883     global canv linehtag commitrow idpos selectedline curview
5884     global mainfont canvxmax iddrawn
5885
5886     if {![info exists commitrow($curview,$id)]} return
5887     if {![info exists iddrawn($id)]} return
5888     drawcommits $commitrow($curview,$id)
5889     $canv delete tag.$id
5890     set xt [eval drawtags $id $idpos($id)]
5891     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
5892     set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
5893     set xr [expr {$xt + [font measure $mainfont $text]}]
5894     if {$xr > $canvxmax} {
5895         set canvxmax $xr
5896         setcanvscroll
5897     }
5898     if {[info exists selectedline]
5899         && $selectedline == $commitrow($curview,$id)} {
5900         selectline $selectedline 0
5901     }
5902 }
5903
5904 proc mktagcan {} {
5905     global mktagtop
5906
5907     catch {destroy $mktagtop}
5908     unset mktagtop
5909 }
5910
5911 proc mktaggo {} {
5912     domktag
5913     mktagcan
5914 }
5915
5916 proc writecommit {} {
5917     global rowmenuid wrcomtop commitinfo wrcomcmd
5918
5919     set top .writecommit
5920     set wrcomtop $top
5921     catch {destroy $top}
5922     toplevel $top
5923     label $top.title -text "Write commit to file"
5924     grid $top.title - -pady 10
5925     label $top.id -text "ID:"
5926     entry $top.sha1 -width 40 -relief flat
5927     $top.sha1 insert 0 $rowmenuid
5928     $top.sha1 conf -state readonly
5929     grid $top.id $top.sha1 -sticky w
5930     entry $top.head -width 60 -relief flat
5931     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5932     $top.head conf -state readonly
5933     grid x $top.head -sticky w
5934     label $top.clab -text "Command:"
5935     entry $top.cmd -width 60 -textvariable wrcomcmd
5936     grid $top.clab $top.cmd -sticky w -pady 10
5937     label $top.flab -text "Output file:"
5938     entry $top.fname -width 60
5939     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5940     grid $top.flab $top.fname -sticky w
5941     frame $top.buts
5942     button $top.buts.gen -text "Write" -command wrcomgo
5943     button $top.buts.can -text "Cancel" -command wrcomcan
5944     grid $top.buts.gen $top.buts.can
5945     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5946     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5947     grid $top.buts - -pady 10 -sticky ew
5948     focus $top.fname
5949 }
5950
5951 proc wrcomgo {} {
5952     global wrcomtop
5953
5954     set id [$wrcomtop.sha1 get]
5955     set cmd "echo $id | [$wrcomtop.cmd get]"
5956     set fname [$wrcomtop.fname get]
5957     if {[catch {exec sh -c $cmd >$fname &} err]} {
5958         error_popup "Error writing commit: $err"
5959     }
5960     catch {destroy $wrcomtop}
5961     unset wrcomtop
5962 }
5963
5964 proc wrcomcan {} {
5965     global wrcomtop
5966
5967     catch {destroy $wrcomtop}
5968     unset wrcomtop
5969 }
5970
5971 proc mkbranch {} {
5972     global rowmenuid mkbrtop
5973
5974     set top .makebranch
5975     catch {destroy $top}
5976     toplevel $top
5977     label $top.title -text "Create new branch"
5978     grid $top.title - -pady 10
5979     label $top.id -text "ID:"
5980     entry $top.sha1 -width 40 -relief flat
5981     $top.sha1 insert 0 $rowmenuid
5982     $top.sha1 conf -state readonly
5983     grid $top.id $top.sha1 -sticky w
5984     label $top.nlab -text "Name:"
5985     entry $top.name -width 40
5986     grid $top.nlab $top.name -sticky w
5987     frame $top.buts
5988     button $top.buts.go -text "Create" -command [list mkbrgo $top]
5989     button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5990     grid $top.buts.go $top.buts.can
5991     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5992     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5993     grid $top.buts - -pady 10 -sticky ew
5994     focus $top.name
5995 }
5996
5997 proc mkbrgo {top} {
5998     global headids idheads
5999
6000     set name [$top.name get]
6001     set id [$top.sha1 get]
6002     if {$name eq {}} {
6003         error_popup "Please specify a name for the new branch"
6004         return
6005     }
6006     catch {destroy $top}
6007     nowbusy newbranch
6008     update
6009     if {[catch {
6010         exec git branch $name $id
6011     } err]} {
6012         notbusy newbranch
6013         error_popup $err
6014     } else {
6015         set headids($name) $id
6016         lappend idheads($id) $name
6017         addedhead $id $name
6018         notbusy newbranch
6019         redrawtags $id
6020         dispneartags 0
6021         run refill_reflist
6022     }
6023 }
6024
6025 proc cherrypick {} {
6026     global rowmenuid curview commitrow
6027     global mainhead
6028
6029     set oldhead [exec git rev-parse HEAD]
6030     set dheads [descheads $rowmenuid]
6031     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6032         set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
6033                         included in branch $mainhead -- really re-apply it?"]
6034         if {!$ok} return
6035     }
6036     nowbusy cherrypick
6037     update
6038     # Unfortunately git-cherry-pick writes stuff to stderr even when
6039     # no error occurs, and exec takes that as an indication of error...
6040     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6041         notbusy cherrypick
6042         error_popup $err
6043         return
6044     }
6045     set newhead [exec git rev-parse HEAD]
6046     if {$newhead eq $oldhead} {
6047         notbusy cherrypick
6048         error_popup "No changes committed"
6049         return
6050     }
6051     addnewchild $newhead $oldhead
6052     if {[info exists commitrow($curview,$oldhead)]} {
6053         insertrow $commitrow($curview,$oldhead) $newhead
6054         if {$mainhead ne {}} {
6055             movehead $newhead $mainhead
6056             movedhead $newhead $mainhead
6057         }
6058         redrawtags $oldhead
6059         redrawtags $newhead
6060     }
6061     notbusy cherrypick
6062 }
6063
6064 proc resethead {} {
6065     global mainheadid mainhead rowmenuid confirm_ok resettype
6066     global showlocalchanges
6067
6068     set confirm_ok 0
6069     set w ".confirmreset"
6070     toplevel $w
6071     wm transient $w .
6072     wm title $w "Confirm reset"
6073     message $w.m -text \
6074         "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
6075         -justify center -aspect 1000
6076     pack $w.m -side top -fill x -padx 20 -pady 20
6077     frame $w.f -relief sunken -border 2
6078     message $w.f.rt -text "Reset type:" -aspect 1000
6079     grid $w.f.rt -sticky w
6080     set resettype mixed
6081     radiobutton $w.f.soft -value soft -variable resettype -justify left \
6082         -text "Soft: Leave working tree and index untouched"
6083     grid $w.f.soft -sticky w
6084     radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6085         -text "Mixed: Leave working tree untouched, reset index"
6086     grid $w.f.mixed -sticky w
6087     radiobutton $w.f.hard -value hard -variable resettype -justify left \
6088         -text "Hard: Reset working tree and index\n(discard ALL local changes)"
6089     grid $w.f.hard -sticky w
6090     pack $w.f -side top -fill x
6091     button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
6092     pack $w.ok -side left -fill x -padx 20 -pady 20
6093     button $w.cancel -text Cancel -command "destroy $w"
6094     pack $w.cancel -side right -fill x -padx 20 -pady 20
6095     bind $w <Visibility> "grab $w; focus $w"
6096     tkwait window $w
6097     if {!$confirm_ok} return
6098     if {[catch {set fd [open \
6099             [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6100         error_popup $err
6101     } else {
6102         dohidelocalchanges
6103         set w ".resetprogress"
6104         filerun $fd [list readresetstat $fd $w]
6105         toplevel $w
6106         wm transient $w
6107         wm title $w "Reset progress"
6108         message $w.m -text "Reset in progress, please wait..." \
6109             -justify center -aspect 1000
6110         pack $w.m -side top -fill x -padx 20 -pady 5
6111         canvas $w.c -width 150 -height 20 -bg white
6112         $w.c create rect 0 0 0 20 -fill green -tags rect
6113         pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
6114         nowbusy reset
6115     }
6116 }
6117
6118 proc readresetstat {fd w} {
6119     global mainhead mainheadid showlocalchanges
6120
6121     if {[gets $fd line] >= 0} {
6122         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6123             set x [expr {($m * 150) / $n}]
6124             $w.c coords rect 0 0 $x 20
6125         }
6126         return 1
6127     }
6128     destroy $w
6129     notbusy reset
6130     if {[catch {close $fd} err]} {
6131         error_popup $err
6132     }
6133     set oldhead $mainheadid
6134     set newhead [exec git rev-parse HEAD]
6135     if {$newhead ne $oldhead} {
6136         movehead $newhead $mainhead
6137         movedhead $newhead $mainhead
6138         set mainheadid $newhead
6139         redrawtags $oldhead
6140         redrawtags $newhead
6141     }
6142     if {$showlocalchanges} {
6143         doshowlocalchanges
6144     }
6145     return 0
6146 }
6147
6148 # context menu for a head
6149 proc headmenu {x y id head} {
6150     global headmenuid headmenuhead headctxmenu mainhead
6151
6152     set headmenuid $id
6153     set headmenuhead $head
6154     set state normal
6155     if {$head eq $mainhead} {
6156         set state disabled
6157     }
6158     $headctxmenu entryconfigure 0 -state $state
6159     $headctxmenu entryconfigure 1 -state $state
6160     tk_popup $headctxmenu $x $y
6161 }
6162
6163 proc cobranch {} {
6164     global headmenuid headmenuhead mainhead headids
6165     global showlocalchanges mainheadid
6166
6167     # check the tree is clean first??
6168     set oldmainhead $mainhead
6169     nowbusy checkout
6170     update
6171     dohidelocalchanges
6172     if {[catch {
6173         exec git checkout -q $headmenuhead
6174     } err]} {
6175         notbusy checkout
6176         error_popup $err
6177     } else {
6178         notbusy checkout
6179         set mainhead $headmenuhead
6180         set mainheadid $headmenuid
6181         if {[info exists headids($oldmainhead)]} {
6182             redrawtags $headids($oldmainhead)
6183         }
6184         redrawtags $headmenuid
6185     }
6186     if {$showlocalchanges} {
6187         dodiffindex
6188     }
6189 }
6190
6191 proc rmbranch {} {
6192     global headmenuid headmenuhead mainhead
6193     global idheads
6194
6195     set head $headmenuhead
6196     set id $headmenuid
6197     # this check shouldn't be needed any more...
6198     if {$head eq $mainhead} {
6199         error_popup "Cannot delete the currently checked-out branch"
6200         return
6201     }
6202     set dheads [descheads $id]
6203     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6204         # the stuff on this branch isn't on any other branch
6205         if {![confirm_popup "The commits on branch $head aren't on any other\
6206                         branch.\nReally delete branch $head?"]} return
6207     }
6208     nowbusy rmbranch
6209     update
6210     if {[catch {exec git branch -D $head} err]} {
6211         notbusy rmbranch
6212         error_popup $err
6213         return
6214     }
6215     removehead $id $head
6216     removedhead $id $head
6217     redrawtags $id
6218     notbusy rmbranch
6219     dispneartags 0
6220     run refill_reflist
6221 }
6222
6223 # Display a list of tags and heads
6224 proc showrefs {} {
6225     global showrefstop bgcolor fgcolor selectbgcolor mainfont
6226     global bglist fglist uifont reflistfilter reflist maincursor
6227
6228     set top .showrefs
6229     set showrefstop $top
6230     if {[winfo exists $top]} {
6231         raise $top
6232         refill_reflist
6233         return
6234     }
6235     toplevel $top
6236     wm title $top "Tags and heads: [file tail [pwd]]"
6237     text $top.list -background $bgcolor -foreground $fgcolor \
6238         -selectbackground $selectbgcolor -font $mainfont \
6239         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6240         -width 30 -height 20 -cursor $maincursor \
6241         -spacing1 1 -spacing3 1 -state disabled
6242     $top.list tag configure highlight -background $selectbgcolor
6243     lappend bglist $top.list
6244     lappend fglist $top.list
6245     scrollbar $top.ysb -command "$top.list yview" -orient vertical
6246     scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6247     grid $top.list $top.ysb -sticky nsew
6248     grid $top.xsb x -sticky ew
6249     frame $top.f
6250     label $top.f.l -text "Filter: " -font $uifont
6251     entry $top.f.e -width 20 -textvariable reflistfilter -font $uifont
6252     set reflistfilter "*"
6253     trace add variable reflistfilter write reflistfilter_change
6254     pack $top.f.e -side right -fill x -expand 1
6255     pack $top.f.l -side left
6256     grid $top.f - -sticky ew -pady 2
6257     button $top.close -command [list destroy $top] -text "Close" \
6258         -font $uifont
6259     grid $top.close -
6260     grid columnconfigure $top 0 -weight 1
6261     grid rowconfigure $top 0 -weight 1
6262     bind $top.list <1> {break}
6263     bind $top.list <B1-Motion> {break}
6264     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6265     set reflist {}
6266     refill_reflist
6267 }
6268
6269 proc sel_reflist {w x y} {
6270     global showrefstop reflist headids tagids otherrefids
6271
6272     if {![winfo exists $showrefstop]} return
6273     set l [lindex [split [$w index "@$x,$y"] "."] 0]
6274     set ref [lindex $reflist [expr {$l-1}]]
6275     set n [lindex $ref 0]
6276     switch -- [lindex $ref 1] {
6277         "H" {selbyid $headids($n)}
6278         "T" {selbyid $tagids($n)}
6279         "o" {selbyid $otherrefids($n)}
6280     }
6281     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6282 }
6283
6284 proc unsel_reflist {} {
6285     global showrefstop
6286
6287     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6288     $showrefstop.list tag remove highlight 0.0 end
6289 }
6290
6291 proc reflistfilter_change {n1 n2 op} {
6292     global reflistfilter
6293
6294     after cancel refill_reflist
6295     after 200 refill_reflist
6296 }
6297
6298 proc refill_reflist {} {
6299     global reflist reflistfilter showrefstop headids tagids otherrefids
6300     global commitrow curview commitinterest
6301
6302     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6303     set refs {}
6304     foreach n [array names headids] {
6305         if {[string match $reflistfilter $n]} {
6306             if {[info exists commitrow($curview,$headids($n))]} {
6307                 lappend refs [list $n H]
6308             } else {
6309                 set commitinterest($headids($n)) {run refill_reflist}
6310             }
6311         }
6312     }
6313     foreach n [array names tagids] {
6314         if {[string match $reflistfilter $n]} {
6315             if {[info exists commitrow($curview,$tagids($n))]} {
6316                 lappend refs [list $n T]
6317             } else {
6318                 set commitinterest($tagids($n)) {run refill_reflist}
6319             }
6320         }
6321     }
6322     foreach n [array names otherrefids] {
6323         if {[string match $reflistfilter $n]} {
6324             if {[info exists commitrow($curview,$otherrefids($n))]} {
6325                 lappend refs [list $n o]
6326             } else {
6327                 set commitinterest($otherrefids($n)) {run refill_reflist}
6328             }
6329         }
6330     }
6331     set refs [lsort -index 0 $refs]
6332     if {$refs eq $reflist} return
6333
6334     # Update the contents of $showrefstop.list according to the
6335     # differences between $reflist (old) and $refs (new)
6336     $showrefstop.list conf -state normal
6337     $showrefstop.list insert end "\n"
6338     set i 0
6339     set j 0
6340     while {$i < [llength $reflist] || $j < [llength $refs]} {
6341         if {$i < [llength $reflist]} {
6342             if {$j < [llength $refs]} {
6343                 set cmp [string compare [lindex $reflist $i 0] \
6344                              [lindex $refs $j 0]]
6345                 if {$cmp == 0} {
6346                     set cmp [string compare [lindex $reflist $i 1] \
6347                                  [lindex $refs $j 1]]
6348                 }
6349             } else {
6350                 set cmp -1
6351             }
6352         } else {
6353             set cmp 1
6354         }
6355         switch -- $cmp {
6356             -1 {
6357                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6358                 incr i
6359             }
6360             0 {
6361                 incr i
6362                 incr j
6363             }
6364             1 {
6365                 set l [expr {$j + 1}]
6366                 $showrefstop.list image create $l.0 -align baseline \
6367                     -image reficon-[lindex $refs $j 1] -padx 2
6368                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6369                 incr j
6370             }
6371         }
6372     }
6373     set reflist $refs
6374     # delete last newline
6375     $showrefstop.list delete end-2c end-1c
6376     $showrefstop.list conf -state disabled
6377 }
6378
6379 # Stuff for finding nearby tags
6380 proc getallcommits {} {
6381     global allcommits allids nbmp nextarc seeds
6382
6383     if {![info exists allcommits]} {
6384         set allids {}
6385         set nbmp 0
6386         set nextarc 0
6387         set allcommits 0
6388         set seeds {}
6389     }
6390
6391     set cmd [concat | git rev-list --all --parents]
6392     foreach id $seeds {
6393         lappend cmd "^$id"
6394     }
6395     set fd [open $cmd r]
6396     fconfigure $fd -blocking 0
6397     incr allcommits
6398     nowbusy allcommits
6399     filerun $fd [list getallclines $fd]
6400 }
6401
6402 # Since most commits have 1 parent and 1 child, we group strings of
6403 # such commits into "arcs" joining branch/merge points (BMPs), which
6404 # are commits that either don't have 1 parent or don't have 1 child.
6405 #
6406 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6407 # arcout(id) - outgoing arcs for BMP
6408 # arcids(a) - list of IDs on arc including end but not start
6409 # arcstart(a) - BMP ID at start of arc
6410 # arcend(a) - BMP ID at end of arc
6411 # growing(a) - arc a is still growing
6412 # arctags(a) - IDs out of arcids (excluding end) that have tags
6413 # archeads(a) - IDs out of arcids (excluding end) that have heads
6414 # The start of an arc is at the descendent end, so "incoming" means
6415 # coming from descendents, and "outgoing" means going towards ancestors.
6416
6417 proc getallclines {fd} {
6418     global allids allparents allchildren idtags idheads nextarc nbmp
6419     global arcnos arcids arctags arcout arcend arcstart archeads growing
6420     global seeds allcommits
6421
6422     set nid 0
6423     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6424         set id [lindex $line 0]
6425         if {[info exists allparents($id)]} {
6426             # seen it already
6427             continue
6428         }
6429         lappend allids $id
6430         set olds [lrange $line 1 end]
6431         set allparents($id) $olds
6432         if {![info exists allchildren($id)]} {
6433             set allchildren($id) {}
6434             set arcnos($id) {}
6435             lappend seeds $id
6436         } else {
6437             set a $arcnos($id)
6438             if {[llength $olds] == 1 && [llength $a] == 1} {
6439                 lappend arcids($a) $id
6440                 if {[info exists idtags($id)]} {
6441                     lappend arctags($a) $id
6442                 }
6443                 if {[info exists idheads($id)]} {
6444                     lappend archeads($a) $id
6445                 }
6446                 if {[info exists allparents($olds)]} {
6447                     # seen parent already
6448                     if {![info exists arcout($olds)]} {
6449                         splitarc $olds
6450                     }
6451                     lappend arcids($a) $olds
6452                     set arcend($a) $olds
6453                     unset growing($a)
6454                 }
6455                 lappend allchildren($olds) $id
6456                 lappend arcnos($olds) $a
6457                 continue
6458             }
6459         }
6460         incr nbmp
6461         foreach a $arcnos($id) {
6462             lappend arcids($a) $id
6463             set arcend($a) $id
6464             unset growing($a)
6465         }
6466
6467         set ao {}
6468         foreach p $olds {
6469             lappend allchildren($p) $id
6470             set a [incr nextarc]
6471             set arcstart($a) $id
6472             set archeads($a) {}
6473             set arctags($a) {}
6474             set archeads($a) {}
6475             set arcids($a) {}
6476             lappend ao $a
6477             set growing($a) 1
6478             if {[info exists allparents($p)]} {
6479                 # seen it already, may need to make a new branch
6480                 if {![info exists arcout($p)]} {
6481                     splitarc $p
6482                 }
6483                 lappend arcids($a) $p
6484                 set arcend($a) $p
6485                 unset growing($a)
6486             }
6487             lappend arcnos($p) $a
6488         }
6489         set arcout($id) $ao
6490     }
6491     if {$nid > 0} {
6492         global cached_dheads cached_dtags cached_atags
6493         catch {unset cached_dheads}
6494         catch {unset cached_dtags}
6495         catch {unset cached_atags}
6496     }
6497     if {![eof $fd]} {
6498         return [expr {$nid >= 1000? 2: 1}]
6499     }
6500     close $fd
6501     if {[incr allcommits -1] == 0} {
6502         notbusy allcommits
6503     }
6504     dispneartags 0
6505     return 0
6506 }
6507
6508 proc recalcarc {a} {
6509     global arctags archeads arcids idtags idheads
6510
6511     set at {}
6512     set ah {}
6513     foreach id [lrange $arcids($a) 0 end-1] {
6514         if {[info exists idtags($id)]} {
6515             lappend at $id
6516         }
6517         if {[info exists idheads($id)]} {
6518             lappend ah $id
6519         }
6520     }
6521     set arctags($a) $at
6522     set archeads($a) $ah
6523 }
6524
6525 proc splitarc {p} {
6526     global arcnos arcids nextarc nbmp arctags archeads idtags idheads
6527     global arcstart arcend arcout allparents growing
6528
6529     set a $arcnos($p)
6530     if {[llength $a] != 1} {
6531         puts "oops splitarc called but [llength $a] arcs already"
6532         return
6533     }
6534     set a [lindex $a 0]
6535     set i [lsearch -exact $arcids($a) $p]
6536     if {$i < 0} {
6537         puts "oops splitarc $p not in arc $a"
6538         return
6539     }
6540     set na [incr nextarc]
6541     if {[info exists arcend($a)]} {
6542         set arcend($na) $arcend($a)
6543     } else {
6544         set l [lindex $allparents([lindex $arcids($a) end]) 0]
6545         set j [lsearch -exact $arcnos($l) $a]
6546         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6547     }
6548     set tail [lrange $arcids($a) [expr {$i+1}] end]
6549     set arcids($a) [lrange $arcids($a) 0 $i]
6550     set arcend($a) $p
6551     set arcstart($na) $p
6552     set arcout($p) $na
6553     set arcids($na) $tail
6554     if {[info exists growing($a)]} {
6555         set growing($na) 1
6556         unset growing($a)
6557     }
6558     incr nbmp
6559
6560     foreach id $tail {
6561         if {[llength $arcnos($id)] == 1} {
6562             set arcnos($id) $na
6563         } else {
6564             set j [lsearch -exact $arcnos($id) $a]
6565             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6566         }
6567     }
6568
6569     # reconstruct tags and heads lists
6570     if {$arctags($a) ne {} || $archeads($a) ne {}} {
6571         recalcarc $a
6572         recalcarc $na
6573     } else {
6574         set arctags($na) {}
6575         set archeads($na) {}
6576     }
6577 }
6578
6579 # Update things for a new commit added that is a child of one
6580 # existing commit.  Used when cherry-picking.
6581 proc addnewchild {id p} {
6582     global allids allparents allchildren idtags nextarc nbmp
6583     global arcnos arcids arctags arcout arcend arcstart archeads growing
6584     global seeds
6585
6586     lappend allids $id
6587     set allparents($id) [list $p]
6588     set allchildren($id) {}
6589     set arcnos($id) {}
6590     lappend seeds $id
6591     incr nbmp
6592     lappend allchildren($p) $id
6593     set a [incr nextarc]
6594     set arcstart($a) $id
6595     set archeads($a) {}
6596     set arctags($a) {}
6597     set arcids($a) [list $p]
6598     set arcend($a) $p
6599     if {![info exists arcout($p)]} {
6600         splitarc $p
6601     }
6602     lappend arcnos($p) $a
6603     set arcout($id) [list $a]
6604 }
6605
6606 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
6607 # or 0 if neither is true.
6608 proc anc_or_desc {a b} {
6609     global arcout arcstart arcend arcnos cached_isanc
6610
6611     if {$arcnos($a) eq $arcnos($b)} {
6612         # Both are on the same arc(s); either both are the same BMP,
6613         # or if one is not a BMP, the other is also not a BMP or is
6614         # the BMP at end of the arc (and it only has 1 incoming arc).
6615         # Or both can be BMPs with no incoming arcs.
6616         if {$a eq $b || $arcnos($a) eq {}} {
6617             return 0
6618         }
6619         # assert {[llength $arcnos($a)] == 1}
6620         set arc [lindex $arcnos($a) 0]
6621         set i [lsearch -exact $arcids($arc) $a]
6622         set j [lsearch -exact $arcids($arc) $b]
6623         if {$i < 0 || $i > $j} {
6624             return 1
6625         } else {
6626             return -1
6627         }
6628     }
6629
6630     if {![info exists arcout($a)]} {
6631         set arc [lindex $arcnos($a) 0]
6632         if {[info exists arcend($arc)]} {
6633             set aend $arcend($arc)
6634         } else {
6635             set aend {}
6636         }
6637         set a $arcstart($arc)
6638     } else {
6639         set aend $a
6640     }
6641     if {![info exists arcout($b)]} {
6642         set arc [lindex $arcnos($b) 0]
6643         if {[info exists arcend($arc)]} {
6644             set bend $arcend($arc)
6645         } else {
6646             set bend {}
6647         }
6648         set b $arcstart($arc)
6649     } else {
6650         set bend $b
6651     }
6652     if {$a eq $bend} {
6653         return 1
6654     }
6655     if {$b eq $aend} {
6656         return -1
6657     }
6658     if {[info exists cached_isanc($a,$bend)]} {
6659         if {$cached_isanc($a,$bend)} {
6660             return 1
6661         }
6662     }
6663     if {[info exists cached_isanc($b,$aend)]} {
6664         if {$cached_isanc($b,$aend)} {
6665             return -1
6666         }
6667         if {[info exists cached_isanc($a,$bend)]} {
6668             return 0
6669         }
6670     }
6671
6672     set todo [list $a $b]
6673     set anc($a) a
6674     set anc($b) b
6675     for {set i 0} {$i < [llength $todo]} {incr i} {
6676         set x [lindex $todo $i]
6677         if {$anc($x) eq {}} {
6678             continue
6679         }
6680         foreach arc $arcnos($x) {
6681             set xd $arcstart($arc)
6682             if {$xd eq $bend} {
6683                 set cached_isanc($a,$bend) 1
6684                 set cached_isanc($b,$aend) 0
6685                 return 1
6686             } elseif {$xd eq $aend} {
6687                 set cached_isanc($b,$aend) 1
6688                 set cached_isanc($a,$bend) 0
6689                 return -1
6690             }
6691             if {![info exists anc($xd)]} {
6692                 set anc($xd) $anc($x)
6693                 lappend todo $xd
6694             } elseif {$anc($xd) ne $anc($x)} {
6695                 set anc($xd) {}
6696             }
6697         }
6698     }
6699     set cached_isanc($a,$bend) 0
6700     set cached_isanc($b,$aend) 0
6701     return 0
6702 }
6703
6704 # This identifies whether $desc has an ancestor that is
6705 # a growing tip of the graph and which is not an ancestor of $anc
6706 # and returns 0 if so and 1 if not.
6707 # If we subsequently discover a tag on such a growing tip, and that
6708 # turns out to be a descendent of $anc (which it could, since we
6709 # don't necessarily see children before parents), then $desc
6710 # isn't a good choice to display as a descendent tag of
6711 # $anc (since it is the descendent of another tag which is
6712 # a descendent of $anc).  Similarly, $anc isn't a good choice to
6713 # display as a ancestor tag of $desc.
6714 #
6715 proc is_certain {desc anc} {
6716     global arcnos arcout arcstart arcend growing problems
6717
6718     set certain {}
6719     if {[llength $arcnos($anc)] == 1} {
6720         # tags on the same arc are certain
6721         if {$arcnos($desc) eq $arcnos($anc)} {
6722             return 1
6723         }
6724         if {![info exists arcout($anc)]} {
6725             # if $anc is partway along an arc, use the start of the arc instead
6726             set a [lindex $arcnos($anc) 0]
6727             set anc $arcstart($a)
6728         }
6729     }
6730     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
6731         set x $desc
6732     } else {
6733         set a [lindex $arcnos($desc) 0]
6734         set x $arcend($a)
6735     }
6736     if {$x == $anc} {
6737         return 1
6738     }
6739     set anclist [list $x]
6740     set dl($x) 1
6741     set nnh 1
6742     set ngrowanc 0
6743     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
6744         set x [lindex $anclist $i]
6745         if {$dl($x)} {
6746             incr nnh -1
6747         }
6748         set done($x) 1
6749         foreach a $arcout($x) {
6750             if {[info exists growing($a)]} {
6751                 if {![info exists growanc($x)] && $dl($x)} {
6752                     set growanc($x) 1
6753                     incr ngrowanc
6754                 }
6755             } else {
6756                 set y $arcend($a)
6757                 if {[info exists dl($y)]} {
6758                     if {$dl($y)} {
6759                         if {!$dl($x)} {
6760                             set dl($y) 0
6761                             if {![info exists done($y)]} {
6762                                 incr nnh -1
6763                             }
6764                             if {[info exists growanc($x)]} {
6765                                 incr ngrowanc -1
6766                             }
6767                             set xl [list $y]
6768                             for {set k 0} {$k < [llength $xl]} {incr k} {
6769                                 set z [lindex $xl $k]
6770                                 foreach c $arcout($z) {
6771                                     if {[info exists arcend($c)]} {
6772                                         set v $arcend($c)
6773                                         if {[info exists dl($v)] && $dl($v)} {
6774                                             set dl($v) 0
6775                                             if {![info exists done($v)]} {
6776                                                 incr nnh -1
6777                                             }
6778                                             if {[info exists growanc($v)]} {
6779                                                 incr ngrowanc -1
6780                                             }
6781                                             lappend xl $v
6782                                         }
6783                                     }
6784                                 }
6785                             }
6786                         }
6787                     }
6788                 } elseif {$y eq $anc || !$dl($x)} {
6789                     set dl($y) 0
6790                     lappend anclist $y
6791                 } else {
6792                     set dl($y) 1
6793                     lappend anclist $y
6794                     incr nnh
6795                 }
6796             }
6797         }
6798     }
6799     foreach x [array names growanc] {
6800         if {$dl($x)} {
6801             return 0
6802         }
6803         return 0
6804     }
6805     return 1
6806 }
6807
6808 proc validate_arctags {a} {
6809     global arctags idtags
6810
6811     set i -1
6812     set na $arctags($a)
6813     foreach id $arctags($a) {
6814         incr i
6815         if {![info exists idtags($id)]} {
6816             set na [lreplace $na $i $i]
6817             incr i -1
6818         }
6819     }
6820     set arctags($a) $na
6821 }
6822
6823 proc validate_archeads {a} {
6824     global archeads idheads
6825
6826     set i -1
6827     set na $archeads($a)
6828     foreach id $archeads($a) {
6829         incr i
6830         if {![info exists idheads($id)]} {
6831             set na [lreplace $na $i $i]
6832             incr i -1
6833         }
6834     }
6835     set archeads($a) $na
6836 }
6837
6838 # Return the list of IDs that have tags that are descendents of id,
6839 # ignoring IDs that are descendents of IDs already reported.
6840 proc desctags {id} {
6841     global arcnos arcstart arcids arctags idtags allparents
6842     global growing cached_dtags
6843
6844     if {![info exists allparents($id)]} {
6845         return {}
6846     }
6847     set t1 [clock clicks -milliseconds]
6848     set argid $id
6849     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6850         # part-way along an arc; check that arc first
6851         set a [lindex $arcnos($id) 0]
6852         if {$arctags($a) ne {}} {
6853             validate_arctags $a
6854             set i [lsearch -exact $arcids($a) $id]
6855             set tid {}
6856             foreach t $arctags($a) {
6857                 set j [lsearch -exact $arcids($a) $t]
6858                 if {$j >= $i} break
6859                 set tid $t
6860             }
6861             if {$tid ne {}} {
6862                 return $tid
6863             }
6864         }
6865         set id $arcstart($a)
6866         if {[info exists idtags($id)]} {
6867             return $id
6868         }
6869     }
6870     if {[info exists cached_dtags($id)]} {
6871         return $cached_dtags($id)
6872     }
6873
6874     set origid $id
6875     set todo [list $id]
6876     set queued($id) 1
6877     set nc 1
6878     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
6879         set id [lindex $todo $i]
6880         set done($id) 1
6881         set ta [info exists hastaggedancestor($id)]
6882         if {!$ta} {
6883             incr nc -1
6884         }
6885         # ignore tags on starting node
6886         if {!$ta && $i > 0} {
6887             if {[info exists idtags($id)]} {
6888                 set tagloc($id) $id
6889                 set ta 1
6890             } elseif {[info exists cached_dtags($id)]} {
6891                 set tagloc($id) $cached_dtags($id)
6892                 set ta 1
6893             }
6894         }
6895         foreach a $arcnos($id) {
6896             set d $arcstart($a)
6897             if {!$ta && $arctags($a) ne {}} {
6898                 validate_arctags $a
6899                 if {$arctags($a) ne {}} {
6900                     lappend tagloc($id) [lindex $arctags($a) end]
6901                 }
6902             }
6903             if {$ta || $arctags($a) ne {}} {
6904                 set tomark [list $d]
6905                 for {set j 0} {$j < [llength $tomark]} {incr j} {
6906                     set dd [lindex $tomark $j]
6907                     if {![info exists hastaggedancestor($dd)]} {
6908                         if {[info exists done($dd)]} {
6909                             foreach b $arcnos($dd) {
6910                                 lappend tomark $arcstart($b)
6911                             }
6912                             if {[info exists tagloc($dd)]} {
6913                                 unset tagloc($dd)
6914                             }
6915                         } elseif {[info exists queued($dd)]} {
6916                             incr nc -1
6917                         }
6918                         set hastaggedancestor($dd) 1
6919                     }
6920                 }
6921             }
6922             if {![info exists queued($d)]} {
6923                 lappend todo $d
6924                 set queued($d) 1
6925                 if {![info exists hastaggedancestor($d)]} {
6926                     incr nc
6927                 }
6928             }
6929         }
6930     }
6931     set tags {}
6932     foreach id [array names tagloc] {
6933         if {![info exists hastaggedancestor($id)]} {
6934             foreach t $tagloc($id) {
6935                 if {[lsearch -exact $tags $t] < 0} {
6936                     lappend tags $t
6937                 }
6938             }
6939         }
6940     }
6941     set t2 [clock clicks -milliseconds]
6942     set loopix $i
6943
6944     # remove tags that are descendents of other tags
6945     for {set i 0} {$i < [llength $tags]} {incr i} {
6946         set a [lindex $tags $i]
6947         for {set j 0} {$j < $i} {incr j} {
6948             set b [lindex $tags $j]
6949             set r [anc_or_desc $a $b]
6950             if {$r == 1} {
6951                 set tags [lreplace $tags $j $j]
6952                 incr j -1
6953                 incr i -1
6954             } elseif {$r == -1} {
6955                 set tags [lreplace $tags $i $i]
6956                 incr i -1
6957                 break
6958             }
6959         }
6960     }
6961
6962     if {[array names growing] ne {}} {
6963         # graph isn't finished, need to check if any tag could get
6964         # eclipsed by another tag coming later.  Simply ignore any
6965         # tags that could later get eclipsed.
6966         set ctags {}
6967         foreach t $tags {
6968             if {[is_certain $t $origid]} {
6969                 lappend ctags $t
6970             }
6971         }
6972         if {$tags eq $ctags} {
6973             set cached_dtags($origid) $tags
6974         } else {
6975             set tags $ctags
6976         }
6977     } else {
6978         set cached_dtags($origid) $tags
6979     }
6980     set t3 [clock clicks -milliseconds]
6981     if {0 && $t3 - $t1 >= 100} {
6982         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
6983             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
6984     }
6985     return $tags
6986 }
6987
6988 proc anctags {id} {
6989     global arcnos arcids arcout arcend arctags idtags allparents
6990     global growing cached_atags
6991
6992     if {![info exists allparents($id)]} {
6993         return {}
6994     }
6995     set t1 [clock clicks -milliseconds]
6996     set argid $id
6997     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
6998         # part-way along an arc; check that arc first
6999         set a [lindex $arcnos($id) 0]
7000         if {$arctags($a) ne {}} {
7001             validate_arctags $a
7002             set i [lsearch -exact $arcids($a) $id]
7003             foreach t $arctags($a) {
7004                 set j [lsearch -exact $arcids($a) $t]
7005                 if {$j > $i} {
7006                     return $t
7007                 }
7008             }
7009         }
7010         if {![info exists arcend($a)]} {
7011             return {}
7012         }
7013         set id $arcend($a)
7014         if {[info exists idtags($id)]} {
7015             return $id
7016         }
7017     }
7018     if {[info exists cached_atags($id)]} {
7019         return $cached_atags($id)
7020     }
7021
7022     set origid $id
7023     set todo [list $id]
7024     set queued($id) 1
7025     set taglist {}
7026     set nc 1
7027     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7028         set id [lindex $todo $i]
7029         set done($id) 1
7030         set td [info exists hastaggeddescendent($id)]
7031         if {!$td} {
7032             incr nc -1
7033         }
7034         # ignore tags on starting node
7035         if {!$td && $i > 0} {
7036             if {[info exists idtags($id)]} {
7037                 set tagloc($id) $id
7038                 set td 1
7039             } elseif {[info exists cached_atags($id)]} {
7040                 set tagloc($id) $cached_atags($id)
7041                 set td 1
7042             }
7043         }
7044         foreach a $arcout($id) {
7045             if {!$td && $arctags($a) ne {}} {
7046                 validate_arctags $a
7047                 if {$arctags($a) ne {}} {
7048                     lappend tagloc($id) [lindex $arctags($a) 0]
7049                 }
7050             }
7051             if {![info exists arcend($a)]} continue
7052             set d $arcend($a)
7053             if {$td || $arctags($a) ne {}} {
7054                 set tomark [list $d]
7055                 for {set j 0} {$j < [llength $tomark]} {incr j} {
7056                     set dd [lindex $tomark $j]
7057                     if {![info exists hastaggeddescendent($dd)]} {
7058                         if {[info exists done($dd)]} {
7059                             foreach b $arcout($dd) {
7060                                 if {[info exists arcend($b)]} {
7061                                     lappend tomark $arcend($b)
7062                                 }
7063                             }
7064                             if {[info exists tagloc($dd)]} {
7065                                 unset tagloc($dd)
7066                             }
7067                         } elseif {[info exists queued($dd)]} {
7068                             incr nc -1
7069                         }
7070                         set hastaggeddescendent($dd) 1
7071                     }
7072                 }
7073             }
7074             if {![info exists queued($d)]} {
7075                 lappend todo $d
7076                 set queued($d) 1
7077                 if {![info exists hastaggeddescendent($d)]} {
7078                     incr nc
7079                 }
7080             }
7081         }
7082     }
7083     set t2 [clock clicks -milliseconds]
7084     set loopix $i
7085     set tags {}
7086     foreach id [array names tagloc] {
7087         if {![info exists hastaggeddescendent($id)]} {
7088             foreach t $tagloc($id) {
7089                 if {[lsearch -exact $tags $t] < 0} {
7090                     lappend tags $t
7091                 }
7092             }
7093         }
7094     }
7095
7096     # remove tags that are ancestors of other tags
7097     for {set i 0} {$i < [llength $tags]} {incr i} {
7098         set a [lindex $tags $i]
7099         for {set j 0} {$j < $i} {incr j} {
7100             set b [lindex $tags $j]
7101             set r [anc_or_desc $a $b]
7102             if {$r == -1} {
7103                 set tags [lreplace $tags $j $j]
7104                 incr j -1
7105                 incr i -1
7106             } elseif {$r == 1} {
7107                 set tags [lreplace $tags $i $i]
7108                 incr i -1
7109                 break
7110             }
7111         }
7112     }
7113
7114     if {[array names growing] ne {}} {
7115         # graph isn't finished, need to check if any tag could get
7116         # eclipsed by another tag coming later.  Simply ignore any
7117         # tags that could later get eclipsed.
7118         set ctags {}
7119         foreach t $tags {
7120             if {[is_certain $origid $t]} {
7121                 lappend ctags $t
7122             }
7123         }
7124         if {$tags eq $ctags} {
7125             set cached_atags($origid) $tags
7126         } else {
7127             set tags $ctags
7128         }
7129     } else {
7130         set cached_atags($origid) $tags
7131     }
7132     set t3 [clock clicks -milliseconds]
7133     if {0 && $t3 - $t1 >= 100} {
7134         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7135             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7136     }
7137     return $tags
7138 }
7139
7140 # Return the list of IDs that have heads that are descendents of id,
7141 # including id itself if it has a head.
7142 proc descheads {id} {
7143     global arcnos arcstart arcids archeads idheads cached_dheads
7144     global allparents
7145
7146     if {![info exists allparents($id)]} {
7147         return {}
7148     }
7149     set aret {}
7150     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7151         # part-way along an arc; check it first
7152         set a [lindex $arcnos($id) 0]
7153         if {$archeads($a) ne {}} {
7154             validate_archeads $a
7155             set i [lsearch -exact $arcids($a) $id]
7156             foreach t $archeads($a) {
7157                 set j [lsearch -exact $arcids($a) $t]
7158                 if {$j > $i} break
7159                 lappend aret $t
7160             }
7161         }
7162         set id $arcstart($a)
7163     }
7164     set origid $id
7165     set todo [list $id]
7166     set seen($id) 1
7167     set ret {}
7168     for {set i 0} {$i < [llength $todo]} {incr i} {
7169         set id [lindex $todo $i]
7170         if {[info exists cached_dheads($id)]} {
7171             set ret [concat $ret $cached_dheads($id)]
7172         } else {
7173             if {[info exists idheads($id)]} {
7174                 lappend ret $id
7175             }
7176             foreach a $arcnos($id) {
7177                 if {$archeads($a) ne {}} {
7178                     validate_archeads $a
7179                     if {$archeads($a) ne {}} {
7180                         set ret [concat $ret $archeads($a)]
7181                     }
7182                 }
7183                 set d $arcstart($a)
7184                 if {![info exists seen($d)]} {
7185                     lappend todo $d
7186                     set seen($d) 1
7187                 }
7188             }
7189         }
7190     }
7191     set ret [lsort -unique $ret]
7192     set cached_dheads($origid) $ret
7193     return [concat $ret $aret]
7194 }
7195
7196 proc addedtag {id} {
7197     global arcnos arcout cached_dtags cached_atags
7198
7199     if {![info exists arcnos($id)]} return
7200     if {![info exists arcout($id)]} {
7201         recalcarc [lindex $arcnos($id) 0]
7202     }
7203     catch {unset cached_dtags}
7204     catch {unset cached_atags}
7205 }
7206
7207 proc addedhead {hid head} {
7208     global arcnos arcout cached_dheads
7209
7210     if {![info exists arcnos($hid)]} return
7211     if {![info exists arcout($hid)]} {
7212         recalcarc [lindex $arcnos($hid) 0]
7213     }
7214     catch {unset cached_dheads}
7215 }
7216
7217 proc removedhead {hid head} {
7218     global cached_dheads
7219
7220     catch {unset cached_dheads}
7221 }
7222
7223 proc movedhead {hid head} {
7224     global arcnos arcout cached_dheads
7225
7226     if {![info exists arcnos($hid)]} return
7227     if {![info exists arcout($hid)]} {
7228         recalcarc [lindex $arcnos($hid) 0]
7229     }
7230     catch {unset cached_dheads}
7231 }
7232
7233 proc changedrefs {} {
7234     global cached_dheads cached_dtags cached_atags
7235     global arctags archeads arcnos arcout idheads idtags
7236
7237     foreach id [concat [array names idheads] [array names idtags]] {
7238         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7239             set a [lindex $arcnos($id) 0]
7240             if {![info exists donearc($a)]} {
7241                 recalcarc $a
7242                 set donearc($a) 1
7243             }
7244         }
7245     }
7246     catch {unset cached_dtags}
7247     catch {unset cached_atags}
7248     catch {unset cached_dheads}
7249 }
7250
7251 proc rereadrefs {} {
7252     global idtags idheads idotherrefs mainhead
7253
7254     set refids [concat [array names idtags] \
7255                     [array names idheads] [array names idotherrefs]]
7256     foreach id $refids {
7257         if {![info exists ref($id)]} {
7258             set ref($id) [listrefs $id]
7259         }
7260     }
7261     set oldmainhead $mainhead
7262     readrefs
7263     changedrefs
7264     set refids [lsort -unique [concat $refids [array names idtags] \
7265                         [array names idheads] [array names idotherrefs]]]
7266     foreach id $refids {
7267         set v [listrefs $id]
7268         if {![info exists ref($id)] || $ref($id) != $v ||
7269             ($id eq $oldmainhead && $id ne $mainhead) ||
7270             ($id eq $mainhead && $id ne $oldmainhead)} {
7271             redrawtags $id
7272         }
7273     }
7274     run refill_reflist
7275 }
7276
7277 proc listrefs {id} {
7278     global idtags idheads idotherrefs
7279
7280     set x {}
7281     if {[info exists idtags($id)]} {
7282         set x $idtags($id)
7283     }
7284     set y {}
7285     if {[info exists idheads($id)]} {
7286         set y $idheads($id)
7287     }
7288     set z {}
7289     if {[info exists idotherrefs($id)]} {
7290         set z $idotherrefs($id)
7291     }
7292     return [list $x $y $z]
7293 }
7294
7295 proc showtag {tag isnew} {
7296     global ctext tagcontents tagids linknum tagobjid
7297
7298     if {$isnew} {
7299         addtohistory [list showtag $tag 0]
7300     }
7301     $ctext conf -state normal
7302     clear_ctext
7303     set linknum 0
7304     if {![info exists tagcontents($tag)]} {
7305         catch {
7306             set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7307         }
7308     }
7309     if {[info exists tagcontents($tag)]} {
7310         set text $tagcontents($tag)
7311     } else {
7312         set text "Tag: $tag\nId:  $tagids($tag)"
7313     }
7314     appendwithlinks $text {}
7315     $ctext conf -state disabled
7316     init_flist {}
7317 }
7318
7319 proc doquit {} {
7320     global stopped
7321     set stopped 100
7322     savestuff .
7323     destroy .
7324 }
7325
7326 proc doprefs {} {
7327     global maxwidth maxgraphpct diffopts
7328     global oldprefs prefstop showneartags showlocalchanges
7329     global bgcolor fgcolor ctext diffcolors selectbgcolor
7330     global uifont tabstop
7331
7332     set top .gitkprefs
7333     set prefstop $top
7334     if {[winfo exists $top]} {
7335         raise $top
7336         return
7337     }
7338     foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7339         set oldprefs($v) [set $v]
7340     }
7341     toplevel $top
7342     wm title $top "Gitk preferences"
7343     label $top.ldisp -text "Commit list display options"
7344     $top.ldisp configure -font $uifont
7345     grid $top.ldisp - -sticky w -pady 10
7346     label $top.spacer -text " "
7347     label $top.maxwidthl -text "Maximum graph width (lines)" \
7348         -font optionfont
7349     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
7350     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
7351     label $top.maxpctl -text "Maximum graph width (% of pane)" \
7352         -font optionfont
7353     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
7354     grid x $top.maxpctl $top.maxpct -sticky w
7355     frame $top.showlocal
7356     label $top.showlocal.l -text "Show local changes" -font optionfont
7357     checkbutton $top.showlocal.b -variable showlocalchanges
7358     pack $top.showlocal.b $top.showlocal.l -side left
7359     grid x $top.showlocal -sticky w
7360
7361     label $top.ddisp -text "Diff display options"
7362     $top.ddisp configure -font $uifont
7363     grid $top.ddisp - -sticky w -pady 10
7364     label $top.diffoptl -text "Options for diff program" \
7365         -font optionfont
7366     entry $top.diffopt -width 20 -textvariable diffopts
7367     grid x $top.diffoptl $top.diffopt -sticky w
7368     frame $top.ntag
7369     label $top.ntag.l -text "Display nearby tags" -font optionfont
7370     checkbutton $top.ntag.b -variable showneartags
7371     pack $top.ntag.b $top.ntag.l -side left
7372     grid x $top.ntag -sticky w
7373     label $top.tabstopl -text "tabstop" -font optionfont
7374     spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
7375     grid x $top.tabstopl $top.tabstop -sticky w
7376
7377     label $top.cdisp -text "Colors: press to choose"
7378     $top.cdisp configure -font $uifont
7379     grid $top.cdisp - -sticky w -pady 10
7380     label $top.bg -padx 40 -relief sunk -background $bgcolor
7381     button $top.bgbut -text "Background" -font optionfont \
7382         -command [list choosecolor bgcolor 0 $top.bg background setbg]
7383     grid x $top.bgbut $top.bg -sticky w
7384     label $top.fg -padx 40 -relief sunk -background $fgcolor
7385     button $top.fgbut -text "Foreground" -font optionfont \
7386         -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
7387     grid x $top.fgbut $top.fg -sticky w
7388     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
7389     button $top.diffoldbut -text "Diff: old lines" -font optionfont \
7390         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
7391                       [list $ctext tag conf d0 -foreground]]
7392     grid x $top.diffoldbut $top.diffold -sticky w
7393     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
7394     button $top.diffnewbut -text "Diff: new lines" -font optionfont \
7395         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
7396                       [list $ctext tag conf d1 -foreground]]
7397     grid x $top.diffnewbut $top.diffnew -sticky w
7398     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
7399     button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
7400         -command [list choosecolor diffcolors 2 $top.hunksep \
7401                       "diff hunk header" \
7402                       [list $ctext tag conf hunksep -foreground]]
7403     grid x $top.hunksepbut $top.hunksep -sticky w
7404     label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
7405     button $top.selbgbut -text "Select bg" -font optionfont \
7406         -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
7407     grid x $top.selbgbut $top.selbgsep -sticky w
7408
7409     frame $top.buts
7410     button $top.buts.ok -text "OK" -command prefsok -default active
7411     $top.buts.ok configure -font $uifont
7412     button $top.buts.can -text "Cancel" -command prefscan -default normal
7413     $top.buts.can configure -font $uifont
7414     grid $top.buts.ok $top.buts.can
7415     grid columnconfigure $top.buts 0 -weight 1 -uniform a
7416     grid columnconfigure $top.buts 1 -weight 1 -uniform a
7417     grid $top.buts - - -pady 10 -sticky ew
7418     bind $top <Visibility> "focus $top.buts.ok"
7419 }
7420
7421 proc choosecolor {v vi w x cmd} {
7422     global $v
7423
7424     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
7425                -title "Gitk: choose color for $x"]
7426     if {$c eq {}} return
7427     $w conf -background $c
7428     lset $v $vi $c
7429     eval $cmd $c
7430 }
7431
7432 proc setselbg {c} {
7433     global bglist cflist
7434     foreach w $bglist {
7435         $w configure -selectbackground $c
7436     }
7437     $cflist tag configure highlight \
7438         -background [$cflist cget -selectbackground]
7439     allcanvs itemconf secsel -fill $c
7440 }
7441
7442 proc setbg {c} {
7443     global bglist
7444
7445     foreach w $bglist {
7446         $w conf -background $c
7447     }
7448 }
7449
7450 proc setfg {c} {
7451     global fglist canv
7452
7453     foreach w $fglist {
7454         $w conf -foreground $c
7455     }
7456     allcanvs itemconf text -fill $c
7457     $canv itemconf circle -outline $c
7458 }
7459
7460 proc prefscan {} {
7461     global maxwidth maxgraphpct diffopts
7462     global oldprefs prefstop showneartags showlocalchanges
7463
7464     foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
7465         set $v $oldprefs($v)
7466     }
7467     catch {destroy $prefstop}
7468     unset prefstop
7469 }
7470
7471 proc prefsok {} {
7472     global maxwidth maxgraphpct
7473     global oldprefs prefstop showneartags showlocalchanges
7474     global charspc ctext tabstop
7475
7476     catch {destroy $prefstop}
7477     unset prefstop
7478     $ctext configure -tabs "[expr {$tabstop * $charspc}]"
7479     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
7480         if {$showlocalchanges} {
7481             doshowlocalchanges
7482         } else {
7483             dohidelocalchanges
7484         }
7485     }
7486     if {$maxwidth != $oldprefs(maxwidth)
7487         || $maxgraphpct != $oldprefs(maxgraphpct)} {
7488         redisplay
7489     } elseif {$showneartags != $oldprefs(showneartags)} {
7490         reselectline
7491     }
7492 }
7493
7494 proc formatdate {d} {
7495     global datetimeformat
7496     if {$d ne {}} {
7497         set d [clock format $d -format $datetimeformat]
7498     }
7499     return $d
7500 }
7501
7502 # This list of encoding names and aliases is distilled from
7503 # http://www.iana.org/assignments/character-sets.
7504 # Not all of them are supported by Tcl.
7505 set encoding_aliases {
7506     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
7507       ISO646-US US-ASCII us IBM367 cp367 csASCII }
7508     { ISO-10646-UTF-1 csISO10646UTF1 }
7509     { ISO_646.basic:1983 ref csISO646basic1983 }
7510     { INVARIANT csINVARIANT }
7511     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
7512     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
7513     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
7514     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
7515     { NATS-DANO iso-ir-9-1 csNATSDANO }
7516     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
7517     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
7518     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
7519     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
7520     { ISO-2022-KR csISO2022KR }
7521     { EUC-KR csEUCKR }
7522     { ISO-2022-JP csISO2022JP }
7523     { ISO-2022-JP-2 csISO2022JP2 }
7524     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
7525       csISO13JISC6220jp }
7526     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
7527     { IT iso-ir-15 ISO646-IT csISO15Italian }
7528     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
7529     { ES iso-ir-17 ISO646-ES csISO17Spanish }
7530     { greek7-old iso-ir-18 csISO18Greek7Old }
7531     { latin-greek iso-ir-19 csISO19LatinGreek }
7532     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
7533     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
7534     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
7535     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
7536     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
7537     { BS_viewdata iso-ir-47 csISO47BSViewdata }
7538     { INIS iso-ir-49 csISO49INIS }
7539     { INIS-8 iso-ir-50 csISO50INIS8 }
7540     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
7541     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
7542     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
7543     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
7544     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
7545     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
7546       csISO60Norwegian1 }
7547     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
7548     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
7549     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
7550     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
7551     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
7552     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
7553     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
7554     { greek7 iso-ir-88 csISO88Greek7 }
7555     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
7556     { iso-ir-90 csISO90 }
7557     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
7558     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
7559       csISO92JISC62991984b }
7560     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
7561     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
7562     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
7563       csISO95JIS62291984handadd }
7564     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
7565     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
7566     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
7567     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
7568       CP819 csISOLatin1 }
7569     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
7570     { T.61-7bit iso-ir-102 csISO102T617bit }
7571     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
7572     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
7573     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
7574     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
7575     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
7576     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
7577     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
7578     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
7579       arabic csISOLatinArabic }
7580     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
7581     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
7582     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
7583       greek greek8 csISOLatinGreek }
7584     { T.101-G2 iso-ir-128 csISO128T101G2 }
7585     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
7586       csISOLatinHebrew }
7587     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
7588     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
7589     { CSN_369103 iso-ir-139 csISO139CSN369103 }
7590     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
7591     { ISO_6937-2-add iso-ir-142 csISOTextComm }
7592     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
7593     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
7594       csISOLatinCyrillic }
7595     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
7596     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
7597     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
7598     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
7599     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
7600     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
7601     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
7602     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
7603     { ISO_10367-box iso-ir-155 csISO10367Box }
7604     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
7605     { latin-lap lap iso-ir-158 csISO158Lap }
7606     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
7607     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
7608     { us-dk csUSDK }
7609     { dk-us csDKUS }
7610     { JIS_X0201 X0201 csHalfWidthKatakana }
7611     { KSC5636 ISO646-KR csKSC5636 }
7612     { ISO-10646-UCS-2 csUnicode }
7613     { ISO-10646-UCS-4 csUCS4 }
7614     { DEC-MCS dec csDECMCS }
7615     { hp-roman8 roman8 r8 csHPRoman8 }
7616     { macintosh mac csMacintosh }
7617     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
7618       csIBM037 }
7619     { IBM038 EBCDIC-INT cp038 csIBM038 }
7620     { IBM273 CP273 csIBM273 }
7621     { IBM274 EBCDIC-BE CP274 csIBM274 }
7622     { IBM275 EBCDIC-BR cp275 csIBM275 }
7623     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
7624     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
7625     { IBM280 CP280 ebcdic-cp-it csIBM280 }
7626     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
7627     { IBM284 CP284 ebcdic-cp-es csIBM284 }
7628     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
7629     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
7630     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
7631     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
7632     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
7633     { IBM424 cp424 ebcdic-cp-he csIBM424 }
7634     { IBM437 cp437 437 csPC8CodePage437 }
7635     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
7636     { IBM775 cp775 csPC775Baltic }
7637     { IBM850 cp850 850 csPC850Multilingual }
7638     { IBM851 cp851 851 csIBM851 }
7639     { IBM852 cp852 852 csPCp852 }
7640     { IBM855 cp855 855 csIBM855 }
7641     { IBM857 cp857 857 csIBM857 }
7642     { IBM860 cp860 860 csIBM860 }
7643     { IBM861 cp861 861 cp-is csIBM861 }
7644     { IBM862 cp862 862 csPC862LatinHebrew }
7645     { IBM863 cp863 863 csIBM863 }
7646     { IBM864 cp864 csIBM864 }
7647     { IBM865 cp865 865 csIBM865 }
7648     { IBM866 cp866 866 csIBM866 }
7649     { IBM868 CP868 cp-ar csIBM868 }
7650     { IBM869 cp869 869 cp-gr csIBM869 }
7651     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
7652     { IBM871 CP871 ebcdic-cp-is csIBM871 }
7653     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
7654     { IBM891 cp891 csIBM891 }
7655     { IBM903 cp903 csIBM903 }
7656     { IBM904 cp904 904 csIBBM904 }
7657     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
7658     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
7659     { IBM1026 CP1026 csIBM1026 }
7660     { EBCDIC-AT-DE csIBMEBCDICATDE }
7661     { EBCDIC-AT-DE-A csEBCDICATDEA }
7662     { EBCDIC-CA-FR csEBCDICCAFR }
7663     { EBCDIC-DK-NO csEBCDICDKNO }
7664     { EBCDIC-DK-NO-A csEBCDICDKNOA }
7665     { EBCDIC-FI-SE csEBCDICFISE }
7666     { EBCDIC-FI-SE-A csEBCDICFISEA }
7667     { EBCDIC-FR csEBCDICFR }
7668     { EBCDIC-IT csEBCDICIT }
7669     { EBCDIC-PT csEBCDICPT }
7670     { EBCDIC-ES csEBCDICES }
7671     { EBCDIC-ES-A csEBCDICESA }
7672     { EBCDIC-ES-S csEBCDICESS }
7673     { EBCDIC-UK csEBCDICUK }
7674     { EBCDIC-US csEBCDICUS }
7675     { UNKNOWN-8BIT csUnknown8BiT }
7676     { MNEMONIC csMnemonic }
7677     { MNEM csMnem }
7678     { VISCII csVISCII }
7679     { VIQR csVIQR }
7680     { KOI8-R csKOI8R }
7681     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
7682     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
7683     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
7684     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
7685     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
7686     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
7687     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
7688     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
7689     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
7690     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
7691     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
7692     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
7693     { IBM1047 IBM-1047 }
7694     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
7695     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
7696     { UNICODE-1-1 csUnicode11 }
7697     { CESU-8 csCESU-8 }
7698     { BOCU-1 csBOCU-1 }
7699     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
7700     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
7701       l8 }
7702     { ISO-8859-15 ISO_8859-15 Latin-9 }
7703     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
7704     { GBK CP936 MS936 windows-936 }
7705     { JIS_Encoding csJISEncoding }
7706     { Shift_JIS MS_Kanji csShiftJIS }
7707     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
7708       EUC-JP }
7709     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
7710     { ISO-10646-UCS-Basic csUnicodeASCII }
7711     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
7712     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
7713     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
7714     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
7715     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
7716     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
7717     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
7718     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
7719     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
7720     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
7721     { Adobe-Standard-Encoding csAdobeStandardEncoding }
7722     { Ventura-US csVenturaUS }
7723     { Ventura-International csVenturaInternational }
7724     { PC8-Danish-Norwegian csPC8DanishNorwegian }
7725     { PC8-Turkish csPC8Turkish }
7726     { IBM-Symbols csIBMSymbols }
7727     { IBM-Thai csIBMThai }
7728     { HP-Legal csHPLegal }
7729     { HP-Pi-font csHPPiFont }
7730     { HP-Math8 csHPMath8 }
7731     { Adobe-Symbol-Encoding csHPPSMath }
7732     { HP-DeskTop csHPDesktop }
7733     { Ventura-Math csVenturaMath }
7734     { Microsoft-Publishing csMicrosoftPublishing }
7735     { Windows-31J csWindows31J }
7736     { GB2312 csGB2312 }
7737     { Big5 csBig5 }
7738 }
7739
7740 proc tcl_encoding {enc} {
7741     global encoding_aliases
7742     set names [encoding names]
7743     set lcnames [string tolower $names]
7744     set enc [string tolower $enc]
7745     set i [lsearch -exact $lcnames $enc]
7746     if {$i < 0} {
7747         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
7748         if {[regsub {^iso[-_]} $enc iso encx]} {
7749             set i [lsearch -exact $lcnames $encx]
7750         }
7751     }
7752     if {$i < 0} {
7753         foreach l $encoding_aliases {
7754             set ll [string tolower $l]
7755             if {[lsearch -exact $ll $enc] < 0} continue
7756             # look through the aliases for one that tcl knows about
7757             foreach e $ll {
7758                 set i [lsearch -exact $lcnames $e]
7759                 if {$i < 0} {
7760                     if {[regsub {^iso[-_]} $e iso ex]} {
7761                         set i [lsearch -exact $lcnames $ex]
7762                     }
7763                 }
7764                 if {$i >= 0} break
7765             }
7766             break
7767         }
7768     }
7769     if {$i >= 0} {
7770         return [lindex $names $i]
7771     }
7772     return {}
7773 }
7774
7775 # defaults...
7776 set datemode 0
7777 set diffopts "-U 5 -p"
7778 set wrcomcmd "git diff-tree --stdin -p --pretty"
7779
7780 set gitencoding {}
7781 catch {
7782     set gitencoding [exec git config --get i18n.commitencoding]
7783 }
7784 if {$gitencoding == ""} {
7785     set gitencoding "utf-8"
7786 }
7787 set tclencoding [tcl_encoding $gitencoding]
7788 if {$tclencoding == {}} {
7789     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
7790 }
7791
7792 set mainfont {Helvetica 9}
7793 set textfont {Courier 9}
7794 set uifont {Helvetica 9 bold}
7795 set tabstop 8
7796 set findmergefiles 0
7797 set maxgraphpct 50
7798 set maxwidth 16
7799 set revlistorder 0
7800 set fastdate 0
7801 set uparrowlen 5
7802 set downarrowlen 5
7803 set mingaplen 100
7804 set cmitmode "patch"
7805 set wrapcomment "none"
7806 set showneartags 1
7807 set maxrefs 20
7808 set maxlinelen 200
7809 set showlocalchanges 1
7810 set datetimeformat "%Y-%m-%d %H:%M:%S"
7811
7812 set colors {green red blue magenta darkgrey brown orange}
7813 set bgcolor white
7814 set fgcolor black
7815 set diffcolors {red "#00a000" blue}
7816 set diffcontext 3
7817 set selectbgcolor gray85
7818
7819 catch {source ~/.gitk}
7820
7821 font create optionfont -family sans-serif -size -12
7822
7823 # check that we can find a .git directory somewhere...
7824 if {[catch {set gitdir [gitdir]}]} {
7825     show_error {} . "Cannot find a git repository here."
7826     exit 1
7827 }
7828 if {![file isdirectory $gitdir]} {
7829     show_error {} . "Cannot find the git directory \"$gitdir\"."
7830     exit 1
7831 }
7832
7833 set revtreeargs {}
7834 set cmdline_files {}
7835 set i 0
7836 foreach arg $argv {
7837     switch -- $arg {
7838         "" { }
7839         "-d" { set datemode 1 }
7840         "--" {
7841             set cmdline_files [lrange $argv [expr {$i + 1}] end]
7842             break
7843         }
7844         default {
7845             lappend revtreeargs $arg
7846         }
7847     }
7848     incr i
7849 }
7850
7851 if {$i >= [llength $argv] && $revtreeargs ne {}} {
7852     # no -- on command line, but some arguments (other than -d)
7853     if {[catch {
7854         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
7855         set cmdline_files [split $f "\n"]
7856         set n [llength $cmdline_files]
7857         set revtreeargs [lrange $revtreeargs 0 end-$n]
7858         # Unfortunately git rev-parse doesn't produce an error when
7859         # something is both a revision and a filename.  To be consistent
7860         # with git log and git rev-list, check revtreeargs for filenames.
7861         foreach arg $revtreeargs {
7862             if {[file exists $arg]} {
7863                 show_error {} . "Ambiguous argument '$arg': both revision\
7864                                  and filename"
7865                 exit 1
7866             }
7867         }
7868     } err]} {
7869         # unfortunately we get both stdout and stderr in $err,
7870         # so look for "fatal:".
7871         set i [string first "fatal:" $err]
7872         if {$i > 0} {
7873             set err [string range $err [expr {$i + 6}] end]
7874         }
7875         show_error {} . "Bad arguments to gitk:\n$err"
7876         exit 1
7877     }
7878 }
7879
7880 set nullid "0000000000000000000000000000000000000000"
7881 set nullid2 "0000000000000000000000000000000000000001"
7882
7883
7884 set runq {}
7885 set history {}
7886 set historyindex 0
7887 set fh_serial 0
7888 set nhl_names {}
7889 set highlight_paths {}
7890 set searchdirn -forwards
7891 set boldrows {}
7892 set boldnamerows {}
7893 set diffelide {0 0}
7894 set markingmatches 0
7895
7896 set optim_delay 16
7897
7898 set nextviewnum 1
7899 set curview 0
7900 set selectedview 0
7901 set selectedhlview None
7902 set viewfiles(0) {}
7903 set viewperm(0) 0
7904 set viewargs(0) {}
7905
7906 set cmdlineok 0
7907 set stopped 0
7908 set stuffsaved 0
7909 set patchnum 0
7910 set lookingforhead 0
7911 set localirow -1
7912 set localfrow -1
7913 set lserial 0
7914 setcoords
7915 makewindow
7916 # wait for the window to become visible
7917 tkwait visibility .
7918 wm title . "[file tail $argv0]: [file tail [pwd]]"
7919 readrefs
7920
7921 if {$cmdline_files ne {} || $revtreeargs ne {}} {
7922     # create a view for the files/dirs specified on the command line
7923     set curview 1
7924     set selectedview 1
7925     set nextviewnum 2
7926     set viewname(1) "Command line"
7927     set viewfiles(1) $cmdline_files
7928     set viewargs(1) $revtreeargs
7929     set viewperm(1) 0
7930     addviewmenu 1
7931     .bar.view entryconf Edit* -state normal
7932     .bar.view entryconf Delete* -state normal
7933 }
7934
7935 if {[info exists permviews]} {
7936     foreach v $permviews {
7937         set n $nextviewnum
7938         incr nextviewnum
7939         set viewname($n) [lindex $v 0]
7940         set viewfiles($n) [lindex $v 1]
7941         set viewargs($n) [lindex $v 2]
7942         set viewperm($n) 1
7943         addviewmenu $n
7944     }
7945 }
7946 getcommits