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