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