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